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Foreword 


From  the  moment  the  powerful  Amiga  appeared,  COMPUTE! 
Books  dedicated  itself  to  supporting  it.  Following  in  the  tradi- 
tion that  spawned  our  best-selling  First  Book  of  Amiga,  COM- 
PUTEl's  Second  Book  of  Amiga  offers  a  wide  range  of  games, 
applications,  tutorials,  and  programming  tips. 

For  game  players  we've  included  the  popular  Laser 
Chess™,  winner  of  COMPUTED  $10,000  programming  con- 
test. A  game  of  strategy  and  skill,  Laser  Chess  defies  descrip- 
tion. Also  contained  are  "Karma,"  a  futuristic  battle  for  control 
of  a  society,  and  "Marbles,"  a  wild,  fast-paced  arcade  game  of 
excitement.  And  for  card  sharks,  we've  included  the  best  of 
computer  solitaire,  "Euchre,"  "Monte  Carlo,"  "Canfield,"  and 
"Casino  Blackjack." 

Two  invaluable  applications,  "Banner  Printer"  and  "Menu 
Planner"  help  at  home  and  at  the  office.  What's  the  weather 
going  to  be  like  in  your  neck  of  the  woods  tomorrow?  Keep 
ahead  of  the  storm  with  "Weather  Wizard." 

Would  you  like  to  know  about  the  Amiga's  amazing 
graphics?  COMPUTERS  Second  Book  of  Amiga  is  loaded  with 
graphics  utilities  and  demos.  Use  the  "IFF  Translator"  to  con- 
vert your  IFF  files  for  use  with  Amiga  Basic.  Enjoy  fractal 
landscapes  with  "Fractal  Mountains,"  and  explore  the  third  di- 
mension with  "3-D  Surfaces." 

If  programming  is  your  niche,  you'll  find  "Ramdisker" 
and  "Zookeeper"  indispensable.  And  you  can  learn  to  en- 
hance BASIC  with  "BASIC  Button." 

As  with  all  COMPUTE!  Books,  COMPUTERS  Second  Book 
of  Amiga  contains  only  programs  that  have  been  rigorously 
and  fully  tested  and  that  are  ready  to  type  in  and  use.  If  you 
prefer  not  to  type  them  in,  a  companion  disk  which  includes 
all  the  programs  from  the  book — ready  to  load  and  run — is 
available.  To  order  the  disk,  use  the  coupon  in  the  back  of  this 
book. 
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CHAPTER  ONE 


Strategy  and 
Thinking  Games 


Laser  Chess 

Mike  Duppong 
Translation  by  Tim  Midkiff 


TM 


Laser  Chess™  won  First  Prize  in  our  $10,000  pro- 
gramming contest  for  COMPUTED  Atari  ST  Disk  & 
Magazine.  Awarded  $5,000  for  its  originality  and 
skillful  programming,  Laser  Chess  is  a  two-player 
strategy  game  patterned  after  traditional  chess — with 
some  fascinating  new  twists.  The  original  version  was 
written  in  Modula-2  for  the  Atari  ST.  Here  we  have 
provided  a  BASIC  translation  for  the  Amiga.  The 
Amiga  version  requires  at  least  512K  of  memory. 


Laser  Chess™,  as  the  name  implies,  is  a  chesslike  strategy 
game  for  two  players.  The  goal  is  to  manipulate  a  laser-firing 
piece  and  various  reflective  objects  to  eliminate  your  oppo- 
nent's king.  As  in  traditional  chess,  there  are  many  ways  to 
accomplish  this.  Type  in  and  save  a  copy  of  the  game  before 
you  play. 

There  are  eight  basic  types  of  pieces  in  Laser  Chess,  and 
each  has  unique  capabilities.  Over  time,  you'll  learn  each 
piece's  advantages  and  limitations.  Obviously,  the  more  you 
play  Laser  Chess,  the  more  you'll  understand  the  pieces  in 
your  arsenal,  which  in  turn  will  make  you  a  better  player.  So 
let's  start  with  a  description  of  the  pieces. 

A  Geometric  Army 

Figure  1-1  shows  each  piece  and  its  name.  Some  sides  of  cer- 
tain pieces  are  highlighted.  This  indicates  a  reflective  surface. 
When  a  laser  beam  strikes  a  reflective  surface,  it  bounces  off 
without  harming  the  piece.  But  if  a  piece  is  hit  by  a  laser  on  a 
nonreflective  surface,  it  is  destroyed. 
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Figure  1-1.  The  Game  Pieces 
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These  are  the  basic  pieces  in  Laser  Chess. 


A  piece  can  also  be  removed  from  the  board  if  it  is  cap- 
tured by  an  opposing  piece.  This  is  similar  to  traditional  chess; 
to  capture  a  piece,  you  simply  move  one  of  your  own  pieces 
onto  its  square. 

In  addition  to  their  ability  to  move  from  square  to  square, 
pieces  with  reflective  surfaces  can  also  be  rotated  in  place  in 
90-degree  increments.  This  lets  you  orient  the  piece  to  protect 
it  against  opposing  laser  shots  or  to  set  up  bounce  shots  with 
your  own  laser. 

The  king  is  the  most  important  piece  in  Laser  Chess.  When 
the  king  is  eliminated,  the  other  player  wins  the  game.  Since  it 
has  no  reflective  surfaces,  it  can  be  destroyed  by  a  laser  from 
any  angle.  It  can  also  be  captured  by  an  opposing  piece.  The 
king  is  not  totally  defenseless,  however.  It  can  capture  any  op- 
posing piece  by  moving  onto  its  square.  But  you  can  use  it  for 
a  capture  only  once  per  turn. 
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The  second  most  important  piece  is  the  laser.  This  piece  is 
your  primary  offensive  weapon;  it's  the  only  piece  which  can 
fire  a  laser  shot.  To  take  aim,  you  can  rotate  it  in  place  at  90- 
degree  angles.  Like  the  king,  the  laser  is  completely  vulnerable 
to  enemy  laser  strikes,  because  it  has  no  reflective  surfaces.  If 
you  lose  your  laser,  the  game  is  not  over,  but  only  the  most 
skillful  (or  incredibly  lucky)  player  can  overcome  its  loss. 

Tricky  Pieces 

The  hypercube  is  an  interesting  piece.  It  can't  harm  an  oppos- 
ing piece  directly,  but  may  very  well  do  so  indirectly.  When 
the  hypercube  is  moved  onto  another  piece  (even  your  own), 
that  piece  disappears  from  its  original  position  and  reappears 
on  a  randomly  selected  empty  square.  This  can  happen  only 
once  per  turn.  The  hypercube  can  be  a  two-edged  sword;  it 
may  relocate  a  piece  to  a  vulnerable  position,  or  it  may  make 
it  possible  for  the  piece  to  capture  an  important  opposing 
piece  on  the  next  move.  The  hypercube  has  no  reflective  sur- 
faces and  cannot  be  rotated.  It  is  invulnerable  to  laser  shots, 
however,  because  it's  made  of  transparent  material — a  laser 
beam  passes  right  through  it.  Remember  that. 

The  beam  splitter  is  another  tricky  piece.  When  a  laser 
beam  strikes  a  splitter's  vertex  (the  point  opposite  its  base),  the 
beam  splits  in  two.  The  two  new  beams  travel  in  opposite  di- 
rections, perpendicular  to  the  original  beam's  path  (see  Figure 
1-2).  When  a  laser  shot  hits  one  of  the  beam  splitter's  reflec- 
tive surfaces,  it  bounces  off  at  a  90-degree  angle  without  split- 
ting. If  the  beam  splitter's  base  is  hit  by  a  laser  shot,  it  is 
destroyed.  The  beam  splitter  can  be  rotated. 

The  blocks  are  fairly  simple  pieces.  However,  they  may 
impose  some  complex  situations.  A  block  can  capture  any  op- 
posing piece  by  moving  onto  that  piece's  square,  much  like  a 
king.  But  unlike  a  king,  a  block  has  one  reflective  side  and  can 
be  rotated  as  the  situation  demands.  Therefore,  blocks  can  be 
used  either  offensively  or  defensively.  A  laser  beam  that  hits 
the  reflective  surface  of  a  block  is  deflected  180  degrees — 
bouncing  the  beam  back  where  it  came  from. 
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Figure  1-2.  A  Beam  Splitter  in  Action 
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As  seen  in  this  magnified  view,  a  beam  splitter's  vertex  reflects  a  laser  shot  in  two 
perpendicular  directions. 


A  diagonal  mirror  cannot  be  destroyed  by  a  laser,  because 
both  of  its  surfaces  are  reflective.  Diagonal  mirrors  can  be  re- 
moved from  the  board  only  when  captured  by  a  block  or  a 
king.  When  a  laser  beam  strikes  a  diagonal  mirror,  the  beam  is 
deflected  90  degrees.  Diagonal  mirrors  can  be  flipped  to  their 
opposite  diagonal,  but  cannot  be  rotated  to  face  horizontally 
or  vertically. 

The  horizontal  mirrors  and  vertical  mirrors  (known  collec- 
tively as  straight  mirrors)  are  also  invulnerable  to  lasers  due  to 
their  reflective  surfaces.  When  a  laser  hits  a  straight  mirror  on 
its  flat  surface,  the  beam  is  deflected  180  degrees.  If  the  laser 
hits  a  straight  mirror  edgewise,  the  beam  passes  straight 
through  it.  (Look  closely  at  Figure  1-2.  A  laser  beam  is  passing 
through  a  horizontal  mirror  just  to  the  left  of  the  beam  split- 
ter.) Straight  mirrors  can  be  rotated  to  become  either  horizon- 
tal or  vertical  mirrors,  but  not  diagonal  mirrors. 
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The  triangular  mirrors  deflect  laser  beams  just  as  diagonal 
mirrors  do,  but  they  are  vulnerable  to  hits  on  their  two 
nonreflective  sides.  A  triangular  mirror  can  be  rotated  in  90- 
degree  increments. 

Making  Moves 

Laser  Chess  requires  512K  of  memory  and  Microsoft  Amiga 
Basic.  At  the  beginning  of  the  game,  you  can  choose  between 
filled  and  unfilled  playing  pieces  by  pressing  F  and  U,  respec- 
tively. This  option  affects  only  the  appearance  of  the  pieces. 

As  in  the  conventional  game  of  chess,  a  move  in  Laser 
Chess  consists  of  moving  or  otherwise  manipulating  a  game 
piece.  The  same  player  always  moves  first  in  Laser  Chess. 
There's  no  particular  advantage  or  disadvantage  to  moving 
first. 

Laser  Chess  is  played  with  the  mouse.  To  move  a  piece, 
position  the  mouse  pointer  over  the  desired  piece  and  hold 
down  the  left  mouse  button.  When  the  ghosted  image  of  that 
piece  appears,  you  can  either  drag  the  piece  to  a  new  location 
or  rotate  it  by  pressing  a  key.  Release  the  mouse  button  to 
drop  the  piece  in  its  new  location. 

A  turn  consists  of  two  moves.  The  number  of  moves  re- 
maining in  a  turn  is  indicated  visually  on  the  screen.  The  color 
of  the  playfield  border  indicates  the  number  of  turns  remain- 
ing and  whose  turn  it  is.  When  the  border  around  the  sides  of 
the  board  are  doubled,  the  player  of  the  border  color  has  two 
moves  left  in  the  turn.  If  the  border  is  single,  the  player  has 
one  move  left  in  the  turn. 

Before  you  move  or  rotate  a  piece,  you  must  select  it. 
When  a  piece  is  selected,  its  appearance  changes  to  a  ghosted 
image. 

If  you  accidentally  select  the  wrong  piece,  you  can  dese- 
lect it  by  placing  it  back  where  you  got  it  from  and  releasing 
it.  Deselecting  is  usually  done  after  rotating  a  piece — more  on 
this  later. 

After  you've  selected  a  piece,  your  next  decision  is 
whether  to  move  or  rotate  it.  Moving  a  distance  of  one  square 
takes  one  move;  moving  two  squares  takes  two  moves  (al- 
though you  can  move  a  piece  two  squares  in  one  step).  Since 
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Figure  1-3.  Game  Board  and  Controls 


This  fullscreen  view  of  Laser  Chess  shows  its  9  X  9  board  grid  and  game  controls. 

you  have  only  two  moves  per  turn,  the  maximum  distance  a 
piece  can  be  moved  in  one  turn  is  two  squares.  The  computer 
does  not  allow  illegal  moves. 

Pieces  can  be  moved  forward,  backward,  left,  or  right,  but 
not  diagonally.  You  can  effectively  move  a  piece  diagonally  by 
using  two  moves — forward  and  right,  for  instance. 

You  cannot  move  a  piece  onto  a  square  occupied  by  an- 
other piece.  The  only  exceptions  are  captures  with  blocks  and 
kings,  and  moves  of  the  hypercube  as  described  above. 

Rotating  a  Piece 

The  computer  does  not  allow  you  to  rotate  a  piece  that's  in- 
capable of  rotation.  Otherwise,  the  piece  rotates  90  degrees 
(one-quarter  turn)  clockwise.  You  may  continue  rotating  the 
piece  to  any  desired  position  before  deselecting  it.  Rotating  a 
piece  to  face  any  direction  takes  only  one  move,  and  the  move 
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is  subtracted  after  the  piece  is  deselected.  If  you  deselect  the 
piece  in  its  original  position,  no  move  is  subtracted. 

You  can  combine  a  rotation  and  a  move  in  a  single  action. 
First,  select  the  piece.  Then  rotate  it  to  the  direction  you  wish 
it  to  face.  Finally,  move  to  any  adjacent  square  (except  a  diag- 
onal) as  you  would  normally  do.  The  piece  moves  to  that 
square  and  faces  in  the  direction  you've  chosen.  Since  rotating 
a  piece  and  moving  a  piece  each  take  one  move,  this  uses  up 
your  turn. 

Special  Features 

At  the  center  of  the  9X9  board  is  a  special  square  called  a 
hypersquare.  It  absorbs  laser  beams  and  acts  like  a  stationary 
hypercube.  That  is,  if  you  try  to  move  a  piece  onto  it,  the 
piece  disappears  from  its  original  position  and  reappears  on  a 
randomly  selected  empty  square.  This  can  happen  only  once 
per  turn,  however. 

There  are  three  buttons  to  the  left  of  the  board.  To  select 
a  button,  move  the  mouse  pointer  over  the  button  and  press 
the  left  mouse  button.  The  button  labeled  Q  allows  you  to  quit 
playing  at  any  time.  When  selected,  this  option  requires  that 
you  confirm  your  decision. 

The  restart  button  (R)  lets  you  start  a  new  game  without 
finishing  the  current  game.  (For  instance,  a  player  may  be  so 
hopelessly  behind  that  he  or  she  wants  to  resign.)  Again,  the 
program  asks  that  you  confirm  this  choice. 

Firing  the  Laser 

The  last  button  is  the  laser  trigger.  When  it's  your  turn,  you 
can  click  this  button  to  fire  your  laser.  Firing  your  laser  takes 
only  one  move,  but  it  can  be  done  only  once  per  turn.  There- 
fore, you  may  want  to  use  your  first  move  in  a  turn  to  aim  the 
laser,  rotate  a  reflecting  piece  to  set  up  a  bounce  shot,  or  move 
another  piece  into  position. 

Of  course,  you  won't  necessarily  be  firing  the  laser  on  ev- 
ery turn.  Much  of  the  strategy  in  Laser  Chess  involves  moving 
and  rotating  your  pieces  to  set  up  complex  shots.  It's  impor- 
tant to  realize  that  any  laser  hit  on  a  piece's  nonreflective  or 
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nontransparent  surface  will  destroy  that  piece.  You  can  de- 
stroy your  own  pieces  just  as  easily  as  you  can  destroy  your 
opponent's.  You  can  even  zap  your  own  laser,  particularly  if 
you  fire  directly  into  the  180-degree  reflective  surface  of  a 
straight  mirror  or  block,  or  if  you  fail  to  anticipate  the  effects 
of  a  beam  splitter.  Be  forewarned. 

Laser  Chess  Strategy 

As  in  the  conventional  game  of  chess,  much  of  the  strategy  in 
Laser  Chess  revolves  around  thoughtful  placement  of  your 
pieces.  However,  the  character  of  the  game  differs  from  that  of 
chess  in  many  ways.  The  laser,  for  example,  can  strike  at  long 
distances  and  in  more  than  one  direction  at  once.  And  the 
hypercube  adds  an  extra  element  of  uncertainty.  The  best 
strategy  for  any  particular  game  depends  to  a  great  extent  on 
the  skill  and  personality  of  your  opponent.  However,  here  are 
some  general  tips  you  may  find  helpful. 

Get  your  mirrors  out  early.  Use  them  to  gain  the  fullest 
potential  of  your  laser.  Try  to  position  mirror  networks  on 
both  sides  of  the  beam  splitter  so  you  can  inflict  as  much 
damage  as  possible. 

Take  advantage  of  the  blocks.  Since  they  "control"  an 
area  around  them  with  their  threat  of  capture,  no  other  pieces 
can  safely  move  within  their  range.  Make  your  opponent  work 
to  displace  them.  Remember  to  rotate  the  reflective  side  of  a 
block  to  the  most  probable  direction  of  laser  fire.  If  you  can 
prevent  a  laser  from  destroying  the  block,  your  opponent  will 
most  likely  have  to  gang  up  on  it  with  two  or  more  of  his  or 
her  own  blocks. 

Use  mirrors  to  protect  your  king.  If  you  surround  your 
king  with  straight  and  diagonal  mirrors,  there  is  no  way  it  can 
be  hit  by  a  laser.  Therefore,  your  opponent  will  have  to  break 
through  your  defense  with  blocks.  (This  is  a  pretty  dirty  trick 
when  all  of  your  opponent's  blocks  have  been  destroyed,  since 
your  king  is  almost  invulnerable.)  Defending  your  king  with 
blocks  is  also  a  good  strategy. 

The  hypercube  should  be  used  sparingly,  since  you  have 
no  idea  where  a  relocated  piece  will  reappear.  Most  players 
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use  the  hypercube  as  a  last  resort:  If  a  piece  is  going  to  be  de- 
stroyed anyway,  it  doesn't  hurt  to  take  a  chance  and  relocate 
it  with  the  hypercube.  Also,  if  your  opponent's  king  is  encir- 
cled with  mirrors,  you  can  march  right  in  with  your  hyper- 
cube, followed  by  a  block.  This  tactic  may  displace  your 
opponent's  defense,  forcing  your  opponent  to  evacuate  the 
king  from  its  mirrored  fortress.  Escorting  the  hypercube  with 
an  adjacent  block  prevents  the  opponent  from  attacking  the 
hypercube  with  his  or  her  king.  Your  opponent's  only  options 
will  be  to  flee  or  be  displaced. 

Laser  Chess™ 

Filename:  LASER  CHESS 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B,  "COM- 
PUTERS Guide  to  Typing  In  Amiga  Programs." 

*  Laser    Chess* 

'Copyright  1987  Compute!  Publications,  Inc. 4 

'All  Rights  Reserved* 

CLEAR ,  25000 :  CLEAR  ,  50000Sc* 

DEFINT  a-z:DEFSN6  r , g, b,mx: RANDOMIZE  TIMER: SCREEN  1, 

320,200,4,14 

WINDOW  3,, (0,0) -(31 1,186), 16,1: WINDOW  OUTPUT  3: COLOR 

,0* 
DIM  sn(8,3,l,l),es(155,l),shape(155,87),piece(9,9),o 
rient(9,9),cLr(9,9)* 

DIM  os(155) ,beamck(3,9,9) , dirck (8, 3, 3) ,bmd0(158) , bmd 
l(22),shpt(8)* 

DIM  ddrcx  ( 1 ,  20)  ,  ddrcy  ( 1 ,  20)  ,  pt  ( 14)  * 

DIM  s (25S) , n (255) , sq (255) , f  req (20, 4) , shptx (8, 19) , shp 
ty(8, 19)* 

LOCATE  l,4i PRINT  CHR*( 169) "1987  Compute!  Publication 
s,  Inc."* 

LOCATE  3,lliPRINT"All  Rights  Reserved"* 
LOCATE  12,9:PRINT" (F)illed  or  (U)nf il led?"* 
WHILE  NOT(k*«"F"  OR  k*«"U"  )  :  k*«UCASE*  ( INKEY*)  :  WEND:  f 
L«k*«"F"* 

PALETTE  0,. 15,. 05,. 5: PALETTE  1, . 15, . 25, . 954 
FOR  i-2  TO  14sPALETTE  i ,. 15, .05, .5: NEXT: PALETTE  15,. 
15,-25, .954 

ON  TIMER(l)  BOSUB  CLock: ti-36-f L*10* 
COLOR  1,0:CLS: LOCATE  10,14sPRINT  "PLEASE   WAIT"* 
LOCATE  12, 1B:PRINT  "seconds": TIMER  ON* 
FOR  i»0  TO  255:s(i)»127-i:NEXT:F0R  i-0  TO  255:n(i)«l 
27-RND*255: NEXT: WAVE  0,s* 

FOR  i-0  TO  127: sq (i >«127-RND*50: NEXT: FOR  i«128  TO  25 
5: sq ( i ) — 128+RND*50: NEXT* 
cop (1)=4: cop (2) -6: BOSUB  InitShapes: BOSUB  InitObjects 
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: TIMER  0FF:CLS4 

RESTORE  PaLetteData:FOR  i«2  TO  14: READ  r , g , b : PALETTE 

i,r,g,b:NEXT4 
PaLetteData:  4 
DATA  0,0,0, .3, .3,  .34 
DATA  .6,0,0,1,0,0,0,-55,0,0,-9,04 
DATA  1,1, 0,1, 1,0, .6, .6, .6, 1,1, 14 
DATA  1,1,0,1,1,0,1,1,04 
Start: 4 

L ( 1 ) -1 : L (2) -1 : Lpx ( 1 ) -4: Lpy  < 1 ) -1 : Lpx  <2) -6: Lpy (2) -94 
COLOR  , 0x6OSUB  DrawBoard: k-0:pL-14 
Main:4 

pL-pL  XOR  3:px-5:py-5:move-2:hycube-0:hysq-0:taken-0 
:fired»14 

LINE(40, 10)-(288, 186) ,cop (pL) ,b: LINE(42, 12)-(286, 184 
) , cop (pL) ,b4 
MovePiece:4 

WHILE  MOUSE (0) >-l : WEND: x-MOUSE (3) : y=MOUSE (4) 4 
px«INT((x-17)/27):py-INT((y+6)/19):moves»04 
IF  NOT((px>0  AND  px<10)  AND  (py>0  AND  py<10))  THEN  O 
ptions4 

IF  cLr(px,py)OpL  THEN  MovePiece4 
piece-piece (px,py) : rot-orient (px,py)4 
obindex-oi (piece, rot) ispx-pxispy-py4 
IF  NOT(obindex>0)  THEN  MovePiece4 

OBJECT. X  obi ndex,x-14: OBJECT. Y  obindex, y-10i OBJECT. 0 
N  obindex 

4 
WHILE  MOUSE  (0X04 

OBJECT. X  obindex,M0USE(l)-14:0BJECT.Y  ob index, MOUSE ( 
2)-104 

IF  INKEY*<>""  THEN4 

rot-(rot+l)  AND  turns (piece) : j-obindex:obindex-oi (pi 
ece,rot)4 

OBJECT. X  obindex,M0USE(l)-14:0BJECT.Y  obindex , MOUSE ( 
2)-104 

OBJECT. OFF  j:WAVE  0,s: SOUND  4000, . 1, 255, 0: OBJECT. ON 
obindex4 
END  IF  4 
WEND4 

OBJECT. OFF  obindex 4 
60SUB  EraseSquare4 

px-INT ( (MOUSE (5) -17) /27) : py»INT ( (MOUSE (6) +6) /19) 4 
BOSUB  CheckMove4 
GOSUB  PutShape4 

IF  piece (px,py)«2  THEN  Lpx (pL) -px :Lpy (pL) »py4 
EndMove: IF  k  THEN  EndGame4 

move-move-moves: IF  move-1  THEN  LINE (40, 10) -(288, 186) 
,0,b4 
IF  move>0  THEN  MovePiece4 
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GOTO  Main* 

4 

CLock:ti=ti-l: LOCATE  12, 14: PRINT  STR*(ti)"  " : RETURN* 

4 

InitShapes:4 

LINE(0,0)-(0,0),10,bf :BET(0,0)-(0,0),pt:PUT(0,0),pt4 

LINE(0,0)-(0, 18>,10:BET(0,0)-(0,18),bmd0:PUT(0,0),bm 

d04 

LINE(0,0)-(26,0),10:BET(0,0)-(26,0),bmdl:PUT(0,0),bm 

dl4 

LINE (0,0) -(26, 18), 2, bf : GET (0,0) - (26, 18), es (0,0) 4 

LINE (0,0) -(26, 18), 3, bf : BET (0,0) - (26, 18) , es (0, 1 ) 4 

RESTORE  LaserDir:FOR  i=0  TO  3: READ  dirx (i ) ,diry (i ) : N 

EXT4 

LaserDir:DATA  0,-1,1,0,0,1,-1,04 

RESTORE  ShapePts4 

k=0:x=0:y«0:FOR  i=l  TO  8:READ  turns (i ), shpt (i )4 

FOR  j=0  TO  shpt (i)+l: READ  shptx (i , j ) , shpty (i , j ) : NEXT 

4 

60SUB  GetShapes:NEXT4 

RESTORE  ShapeRefLect4 

FOR  i=l  TO  8: FOR  j=0  TO  turns (i)s FOR  k=0  TO  3: READ  d 

irck(i, j,k):NEXT  k,j,i4 

RETURN4 

ShapePts:4 

DATA  1,1,-1,17,17,1,0,04 

DATA  3,6,7,17,9,1,11,17,7,17,1,15,17,15,11,17,9,94 

DATA  1,1,-1,9,17,9,0,04 

DATA  0,7,5,9,9,5,13,9,9,13,5,9, 13,9,9,13,9,5,0,04 

DATA  3,6,1,2,17,2,17,17,1,17,1,2,-1,1,17,1,9,94 

DATA  0,4,1,1, 17, 1,17,17, 1 , 17, 1 , 1 , 0, 04 

DATA  3,6,2,1,16,1,9,8,2,1,-1,1,-9,9,17, 1,9,44 

DATA  3,5,2,17, 17,17,17,2,2,17,-1, 17, 17, 1,13,134 

ShapeRef  Lect : 4 

DATA  1,0,3,2,3,2,1,0,-1,-1,-1,-1,-1,-1,-1,-14 

DATA  -1,-1,-1,-1,-1,-1,-1,-1,2, 1,0,3,0,3,2,14 

DATA  -1,-1,-1,-1,-1,-1,0,-1,-1,-1,-1,1,2,-1,-1,-14 

DATA  -1,3,-1,-1,0,1,2,3,-2,2,-1,2,3,-2,3,-14 

DATA  -1,0,-2,0,1,-1,1,-2,-1,0,3,-1,-1,-1,1,04 

DATA  1,-1,-1,2,3,2,-1,-14 

4 

6etShapes:4 

FOR  angLe-0  TO  turns (i): FOR  bkgd-0  TO  l:FOR  pL-1  TO 

24 

co«cop (pL) : PUT (0,0), es (0, bkgd ) , PSET4 

ON  angLe+1  BOSUB  rotate0,rotate90, rotatel30,rotate27 

04 

sn(i,angLe,pL-l,bkgd)«k:6ET(0,0)-(26, 18) , shape (0, k) : 

k«k+14 

NEXT  pL,bkgd,angLe:RETURN4 

4 
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rotate0:4 

FOR  j-1  TO  shpt  (i): IF  shptx (i , j-1 )<0  THEN  hue«co+l  E 

LSE  hue-co4 

LINE (ABS (shptx (i  , j-1 ) ) +4+x , shpty ( i  ,  j-1 ) +y ) - (ABS (shpt 

x  ( i  ,  j )  ) +4+x , shpty ( i , j ) +y ) , hue: NEXT4 

IF  shptx (i, shpt (i)+l)>0  AND  fL  THEN  PAINT (shptx (i , sh 

pt ( i ) +1 ) +4+x , shpty ( i , shpt ( i ) +1 ) +y ) , co,co4 

RETURN* 

rotate90:4 

FOR  j-1  TO  shpt (i): IF  shptx (i , j-1 )<0  THEN  hue-co+1  E 

LSE  hue-co4 

LINE ( 18-shpty ( i , j-1 ) +4+x , ABS (shptx ( i , j-1 ) ) +y ) - ( 18-sh 

pty ( i , j ) +4+x , ABS (shptx ( i , j ) ) +y ) , hue: NEXT4 

IF  shptx <i,mhpt(i)+l>>0  AND  fL  THEN  PAINT ( 18-shpty (i 

, shpt ( i ) +1 ) +4+x , shptx ( i , shpt ( i ) +1 ) +y ) , co , co4 

RETURN* 

rotat»180:4 

FOR  j-1  TO  shpt (i): IF  shptx (i , j-1 )<0  THEN  hue-co+1  E 

LSE  hu«-co4 

LINE ( 18-ABS (shptx ( i , j-1 ) ) +4+x , 18-shpty ( i , j-1 ) +y ) - ( 18 

-ABS (shptx ( i , j ) ) +4+x , 18-shpty ( i , j ) +y ) , hues  NEXT4 

IF  shptx (i, shpt (i)+l)>0  AND  fL  THEN  PAINT (18-shptx (i 

, shpt (i ) +1 ) +4+x , 18-shpty (i , shpt ( i ) +1 ) +y ) , co, co4 

RETURN4 

rotate270:4 

FOR  j-1  TO  shpt (i>: IF  shptx (i f j-1 )<0  THEN  hue-co+1  E 

LSE  hue-co4 

LINE (shpty ( i , j-1 ) +4+x , 18-ABS (shptx ( i , j-1 ) ) +y ) - (shpty 

( i , j ) +4+x , 18-ABS ( shptx ( i , j  >  >  +y > , hue: NEXT4 

IF  shptx ( i, shpt (i)+l)>0  AND  fL  THEN  PAINT (shpty (i , sh 

pt (i ) +1 ) +4+x , 18-shptx (i , shpt ( i ) +1 ) +y ) , co, co4 

RETURN4 

4 

Init0bjects:4 

k-1 : si S-STRINBS (26,0): POKE  SADD(si«) +1 1 , 4: POKE  SADD( 

si*)+15,274 

POKE  SADD (siS) +19, 19s  POKE  SADD(si*)+21 , 24: POKE  SADD( 

siS)+23,154 

FOR  piece-1  TO  8:F0R  angLe-0  TO  turns (piece) : seLect- 

sn (pi  ece, angLe, 0, 0) 4 

PUT (0, 0) , es (0, 0) , PSET: PUT (0, 0) , shape (0, seLect ) 4 

oi (piece, angLe)-k:6ET(0,0)-(26, 18) ,os4 

sd*-,,n:FOR  i-3  TO  154:  sd*-sd*+MKI*  (os  (i  ) )  :NEXT4 

OBJECT -SHAPE  k, si S+sd*: OBJECT- PLANES  k,3,84 

k-k+l:NEXT  angLe, piece: RETURN4 

4 

DrawBoards4 

COLOR  3,2:LINE(ll,54)-STEP(16,ll),,b:PAINT(12,55),2, 

3: LOCATE  8,3:PRINT"Q"4 

LINE ( 1 1 , 94) -STEP ( 16, 10) ,, b: PAINT ( 12, 95) , 2, 3: LOCATE  1 

3,3:PRINT"R"4 
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LINE ( 1 1 , 134) -STEP (16, 10) , , b: PAINT (12, 135) , 2, 3: LOCATE 

18,3:PRINT"L"  4 
FOR  py-1  TO  9: FOR  px  =  l  TO  9:G0SUB  EraseSquare:NEXT  p 
x,py4 

LINE ( 151, 89) -(177, 107), 0,bf 4 

RESTORE  ShapePosrFOR  py=l  TO  2:F0R  px*l  TO  9:cLr(px, 
py ) «1 :  cLr (px , py+7) «24 

READ  piece(px,py) , orient (px,py) , orient (10-px, 10-py)4 
piece (10-px, 10-py) apiece (px, py) :NEXT  px,py4 
FOR  px»l  TO  9: FOR  py«l  TO  9: IF  piece (px , py) >0  THEN  G 
OSUB  PutShape4 
NEXT  py,px4 
ShapePos:4 

DATA  8,2,0,8,2,0, 1,1, 1,2,2,0,4,0,0,6,0,04 
DATA  1,0,0,8,3,1,8,3, 1,8,3, 1,5,2,0,5,2,04 
DATA  7,2,0,3,0,0,3,1,1,5,2,0,5,2,0,8,2,04 
RETURN4 
4 

PutShape:4 

x=px*27+16:y=py*19-6:bkgd=(px+py+l)  AND  14 
PUT (x , y) , shape (0, sn (piece (px , py) , orient (px , py) , cLr (p 
x,py)-l,bkgd)),PSET4 
RETURN4 
4 

EraseSquare: 4 

x=px*27+16:y=py*19-6:bkgd=(px+py+l)  AND  l:PUT(x,y),e 
s(0,bkgd),PSET4 
RETURN4 
4 

Fires  4 

px«Lpx (pL) :py»Lpy (pL) :Lx ( 1) «px :Ly ( 1 )«py: dir  (D-wien 
t(px,py)4 

FOR  i«l  TO  3:aLive(i)=0:term(i)-0:NEXTiaLive(l)*14 
WHILE  (aLive(l)«l)  OR  (aLive(2)-l)  OR  (aLi ve(3)«l )4 
FOR  i-1  TO  3iIF  aLivtdXl  THEN  AdvBeam4 
nLx  (i)«Lx  (i)+dirx  (dir  (i)  )  inLy  (i  )«Ly  (i  )  +diry  (dir  (i  )  )4 
IF  beamck(dir(i),Lx(i),Ly(i))-l  THEN  EndBeam4 
beamck (di  r ( i ) , Lx ( i ) , Ly ( i ) ) »1 : GOTO  DrawBeam4 
Hitsterm(i)«l:drk(i)-tdirsIF  d  THEN  EndBeam4 
tx«pxsty«py:px«Lx (i ) spy-Ly (i ) : IF  piece (px , py) =4  THEN 

k»k+cLr (px , py ) 4 
IF  piece(px,py)=2  THEN  L (cLr (px, py) )=04 
x«px*27+16:y«py* 19-64 

m=piece(px,py) :shpt (0)*»hpt (m) :FOR  j«0  TO  shpt(0)+l: 
shptx (0, j ) -shptx (m, j ) 4 

shpty  (0,  j )  »»hpty  (m,  j )  : :  NEXT:  t«i  :  i -0:  co=«84 
ON  orient (px,py)+l  GOSUB  rotate0,rotate909rotatel80, 
rotate2704 
i  *t : px  «t x : py«ty4 
EndBeam:aLive(i  )=»-14 
AdvBeam: NEXT: WEND4 
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RETURN* 

4 

DrawBeam:4 

x-Lx<i)*27+29:y«Ly<i>* 19+34 

ON  dir(i)  GOTO  BRt,BDnfBLt4 

BUp : PUT  <x , y-19) , bmd0: GOTO  CkBeam4 

BRt : PUT <xfy+l),bmdl: GOTO  CkBeam4 

BDn: PUT <x+lfy)fbmd0: GOTO  CkBeam4 

BLt : PUT  <x-27, y ) , bmd 1 : GOTO  CkBeam4 

4 

CkBeam:4 

IF  <nLx(i)>9)  OR  (nLy(i)>9)  OR  (nLx(iXl)  OR  (nLy(i) 

<1>  THEN  EndBeam4 

IF  nLx(i)-S  AND  nLy(i)-5  THEN  EndBeam4 

Lx(i)-nLx(i):Ly(i)»nLy(i):IF  piece CnLx <i > fnLy<i > >-0 

THEN  AdvBeam4 

tdir-dir  <i ) : dir  <i  >=dirck  <piece<Lx (i ) , Ly (i ) ) , orient (L 

x(i),Ly<i))fdir(i))4 

IF  dir<i>— 1  THEN  Hit4 

IF  dir(i)>-2  THEN  AdvBeam4 

IF  aLive<2>»0  THEN  j-2  ELSE  j-34 

aLive(j)-l:Lx<j>«Lx<i):Ly<j>-Ly<i>4 

dir(i)-tdir+l  AND  3:dir < j)-tdir-l  AND  34 

GOTO  AdvBeam4 

4 

Lamer : 4 

k-0:d«0:GOSUB  Fire4 

FOR  i-0  TO  3: FOR  x-1  TO  9: FOR  y-1  TO  9:beamck <i , x, y> 

-0:NEXT  y,x,i4 

FOR  i-1  TO  34 

IF  term(i)-l  THEN4 

IF   piece<Lx<i>fLy<i))>0   THEN4 

tx-px: ty«py:px-Lx (i ) :py«Ly(i ) :GOSUB   ExpLode:px— tx:py 

-ty4 

END    IF4 

END    IF4 

NEXT4 

TIMER   OFF:d-l:GOSUB   Fire4 

FOR    i«l    TO   34 

IF   term(i)-l    THEN4 

IF   piece <Lx<i>,Ly(i>>>0   THEN4 

tx-px :ty-py:px-Lx (i ) :py-Ly <i ) : piece (px,py)=0scLr (px, 

py>-04 

GOSUB  EraseSquare:px-tx:py-ty4 

END  IF4 

END  IF4 

NEXT4 

FOR  i-0  TO  3: FOR  x-1  TO  9: FOR  y-1  TO  9:beamck <i f x ,y> 

-0s  NEXT  y,x,i4 

RETURN4 

4 

ExpLode:4 
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FOR  j-0  TO  4:vol (4-j >= ( j+1 > *40: NEXT: ch-0* 

FOR  j-0  TO  20:t=900-INT(RND*8)*100:FOR  m-0  TO  4:freq 

(j,m>=t:NEXT  m,j* 

Lv-120:cx-px*27+29:cy-py* 19+3: WAVE  0,n:WAVE  l,n* 

IF  dirx(drk(i>>«0  THEN* 

FOR  j-0  TO  20:ddrcy(0, j)-INT (RND*10> tdiry (drk (i > >+cy 

* 

ddrcx (0,j)«cx+10-INT(RND*20>* 

ddrcyd,  j) -INT  (RND*20>  tdiry  (drk  (i>  >+cy* 

ddrcx ( 1 , j ) »cx+20-INT (RND*40> : NEXT* 

ELSE* 

FOR  j-0  TO  20:ddrcx(0, j)-INT(RND*10> *dirx (drk (i > >+cx 

* 

ddrcy (0, j ) «cy+10-INT (RND*20> * 

ddrcx ( 1 , j ) -INT (RND*20) *di  rx (drk ( i ) ) +cx* 

ddrcy ( 1 , j ) «cy+20-INT (RND*40) : NEXT* 

END  IF* 

QOSUB  EraseSquare* 

FOR  j-0  TO  20: PUT (ddrcx (0, j), ddrcy (0,j)),pt: IF  (j  AN 

D  4) -4  THEN  GOSUB  ExpSnd* 

NEXT* 

FOR  j-0  TO  20: PUT (ddrcx (0, j), ddrcy (0, j) ) , pt:PUT(ddrc 

x  ( 1 , j ) , ddrcy ( 1 , j ) ) , pt* 

IF  (j  AND  4) -4  THEN  GOSUB  ExpSnd* 

NEXT: FOR  j-0  TO  20: PUT (ddrcx (1 , j ) , ddrcy ( 1 , j )) ,pt:NEX 

T* 

RETURN* 

* 

ExpSnd:* 

ch«l-ch:FOR  m-0  TO  4: SOUND  f req ( j , m) , -  05, vol (m) , ch: N 

EXT: RETURN* 

* 

* 

CheckMove:* 

dx-ABS (px-spx ) : dy=ABS (py-spy ) * 

moves-dx +dy+ABS ( r ot <  >or  i  ent ( spx , spy ) ) * 

IF  dx-0  AND  dy-0  THEN  VaLidMove* 

IF  NOT(px>0  AND  px<10  AND  py>0  AND  py<10)  THEN  InVaL 

idMove* 

IF  moves >move  THEN  In VaLidMove* 

IF  moves-2  THEN* 

midx- (px+spx ) /2:midy= (py+spy) /2* 

IF  midx-5  AND  midy-5  THEN  InVaLidMove* 

IF  dx=2  THEN  IF  piece(midx , py) <>0  THEN  InVaLidMove* 

IF  dy-2  THEN  IF  piece (px , midy) <>0  THEN  InVaLidMove* 

IF  dx-1  AND  dy=l  THEN* 

IF  ( (piece (px, spy) <>0)  OR  (px=5  AND  spy=5) )  AND  ((pi 

ece(spx,py)<>0)  OR  (spx-5  AND  py=5) )  THEN  InVaLidMov 

e* 

END  IF* 

END  IF   * 
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IF  piece (px,py><>0  THEN* 

IF  piece-4  OR  piece-5  THEN4 

IF  taken  THEN  InVaLidMove4 

IF  piece(px,py>-4  THEN  k-cLr (px , py>4 

IF  piece(px,py>-2  THEN  L (cLr (px, py> >«04 

WAVE  0,n:WAVE  l,n4 

FOR  i«255  TO  10  STEP  -20: SOUND  400, . 1 , i , 0: SOUND  400, 

-l,i,l:NEXT4 

taken-liGOTO  VaLidMove4 

ELSE IF  piece-6  THEN4 

IF  hycube  THEN  InVaLidMove4 

hycube- 1 : GOTO  Hyper Cube4 

ELSE4 

GOTO  InVaLidMove4 

END  IF4 

END  IF4 

IF  N0T(px«5  AND  py«5>  THEN  VaLidMove4 

IF  hysq  THEN  InVaLidMove* 

WHILE  (px-5  AND  py-5>  OR  piece(px,py)  O04 

px-INT (RND*9+1 ) : py-INT  (RND*9+1 ) 4 

WEND4 

WAVE  0,n:FOR  i-250  TO  0  STEP  -2: SOUND  100+i *2, .03, i , 

0: NEXT: WAVE  l,n4 

GOSUB  VaLidMove:FOR  1-0  TO  250  STEP  2: SOUND  100+500- 

1*2, -03, i,l:NEXT4 

hymq-1: GOSUB  PutShape4 

RETURNS 

Hyper Cube: 4 

nx-INT  (RND*9+1 )  :  ny-INT  (RND*9+1 )  4 

IF  (nx«5  AND  ny«5)  OR  piece(nx , ny)<>0  THEN  HyperCube 

4 

WAVE  0,n:FOR  1=250  TO  0  STEP  -2: SOUND  100+1*2, . 03, 1 , 

0: NEXT: WAVE  l,n4 

piece(nx,ny)-piece(px,py) : orient (nx,ny) -orient (px,py 

) :cLr (nx,ny)«cLr (px,py)4 

GOSUB  VaLidMove:FOR  1-0  TO  250  STEP  2: SOUND  100+500- 

1*2, .03,i,l:NEXT4 

GOSUB  PutShape: piece (spx , spy ) -0: cLr (spx , spy) -0: px«nx 

: py«ny4 

RETURN4 

4 
VaLidMove:4 

piece (px, py) -piece: orient (px,py)«rot:cLr (px,py)-cLr ( 
spx, spy) 4 

IF  dx>0  OR  dy>0  THEN  piece (spx, spy )«0:cLr (spx, spy) -0 
4 

RETURN4 
InVaLidMove:4 

px«mpx : py«*py : movem-0: RETURN4 
4 

Confirm: 4 
WINDOW  2,, ( 114, G2>- (216, 105), 0,1: WINDOW  OUTPUT  2:PRI 
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NT"Are  you  sure?"4 

COLOR  3,2:LINE(27, 14)-STEP(16, 10) , ,b: PAINT(28, 15) ,2, 

3s LOCATE  3,5:PRINT"Y,,4 

LINE (59, 14) -STEP (16, 10) , , b: PAINT (68, 15) , 2, 3: LOCATE  3 

,9:PRINT,,N"« 

CkCon: WHILE  MOUSE (0) >-l : WEND: x-MOUSE (3) : y»MOUSE (4) : c 

o«P0INT(x,y)4 

IF  N0T(co-2  OR  co«3)  THEN  CkCon4 

IF  x>27  AND  x<43  THEN4 

c-14 

ELSE IF  x>59  AND  x<75  THEN4 

c-04 

ELSE4 

GOTO  CkCon4 

END  IF4 

WINDOW  CLOSE  2: WHILE  MOUSE (0)< >0: WEND: RETURN4 

4 

Options: 4 

co«POINT (x , y ) : moves«04 

IF  N0T(co«2  OR  co«3)  THEN  MovePiece4 

IF  y>133  AND  y<145  AND  fired  AND  L(pL)  THEN4 

fired=0: PALETTE  10, 1, 1,0: PALETTE  15,1,1,04 

WAVE  2,sq:WAVE  3,sq:0N  TIMER(l)  GOSUB  LSnd:Lv-200:GO 

SUB  LSnd: TIMER  0N4 

GOSUB  Laser: moves* 14 

PALETTE  10, -6,. 6,. 6: PALETTE  15, . 15, . 25, . 954 

ELSE IF  y>93  AND  y<105  THEN4 

GOSUB  Confirm: IF  c  THEN  Restart4 

ELSE IF  y>53  AND  y<66  THEN4 

GOSUB  Confirm: IF  c  THEN  SCREEN  CLOSE  1: WINDOW  CLOSE 

3: CLEAR, 25000: END4 

END  IF4 

GOTO  EndMove4 

4 

LSnd: SOUND  120, 18.2, Lv, 2: SOUND  121 , 18. 2, Lv, 3: RETURNS 

4 

Border : LINE (40, 10) - (288, 186) , , b: LINE (42, 12) - (286, 184 

),,b:RETURN4 

4 

Restart: 4 

COLOR  ,0:CLS:FOR  i«l  TO  9:  FOR  j-1  TO  9:  pieced  ,  j )  «0: 

cLr(i, j)»0:NEXT  j,i4 

GOTO  Start4 

4 

EG0pt:4 

co=P0INT(x,y)4 

IF  co-2  OR  co«3  THEN4 

IF  y>93  AND  y<105  THEN  Restart4 

IF  y>53  AND  y<66  THEN  SCREEN  CLOSE  1: WINDOW  CLOSE  3: 

CLEAR, 25000: END4 

END  IF4 
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GOTO  EndGWait* 

4 

End Game: 4 

IF  k=3  THEN* 

COLOR  10,0&GOSUB  Border: COLOR  111  LOCATE  1 , 19:PRINT"D 

raw"* 

ELSE* 

IF  k*2  THEN  COLOR  4,0:GOSUB  Border: COLOR  5: LOCATE  1, 

16:PRINT"Red";* 

IF  k-1  THEN  COLOR  6,0:GOSUB  Border: COLOR  7: LOCATE  1, 

15:PRINT"Green";* 

PRINT"  victory"* 

END  IF* 

EndGWait:* 

WHILE  MOUSE (0) >-l : MEND: x -MOUSE (3) : y-MOUSE <4>  * 

px«INT<(x-G>/27):py«INT(<y+6>/19>:moves«0* 

IF  NOT((px>0  AND  px<10)  AND  (py>0  AND  py<10))  THEN  E 

GOpt* 

GOTO  EndGWait* 
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Karma 

Todd  Heimarck  and  Rhett  Anderson 

"Karma"  is  a  mind-twisting  strategy  game  for  two 
players.  You  control  the  collective  morale  of  a  soci- 
ety. Depending  on  your  ability,  the  people  thrive  or 
just  survive.  The  program  demonstrates  the  power  of 
the  Amiga  hardware  and  Amiga  Basic.  At  least  512K 
of  RAM  is  required. 


Imagine  that  you  have  the  power  to  make  people  very  happy. 
Perhaps  you're  a  vice  president  in  charge  of  awarding  college 
scholarships.  Or  you're  a  billionaire  who  enjoys  giving  some- 
one ten  thousand  bucks.  Or  maybe  you  just  have  a  nice  smile. 

Paradoxically,  while  you're  being  altruistic  and  are  dis- 
pensing gifts  to  a  grateful  and  increasingly  happy  world, 
you're  greedy,  too.  You  want  to  gain  the  approval  and  adora- 
tion of  the  beneficiaries  of  your  largesse.  You  want  people  to 
like  you. 

Unfortunately,  there's  another  philanthropist  who  has  the 
same  power  as  you.  While  you're  dispensing  your  gifts  and 
making  people  happy,  your  opponent  is  doing  the  same  thing. 
You're  locked  in  a  popularity  contest  from  which  only  one  vic- 
tor will  emerge. 

"Karma"  is  a  two-player  strategy  game  in  which  you  and 
your  opponent  struggle  for  territory.  Four  different  scenarios — 
each  with  a  different  goal — are  included.  Players  take  turns 
using  the  mouse  to  add  happiness  to  households.  When  a  cer- 
tain level  of  happiness  builds  up,  an  explosion  takes  place. 
When  one  of  the  players  achieves  an  explosion,  that  player 
captures  all  of  the  surrounding  regions.  Karma  is  easy  to  play, 
but  difficult  to  win. 
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Getting  Started 

Karma  is  written  in  Amiga  Basic.  Type  it  in  and  save  a  copy  to 
disk.  When  you're  ready  to  play  the  game,  run  it.  When  you 
play,  you'll  first  be  asked  to  choose  one  of  the  four  karmic 
variations:  Capture  All,  Four  Corners,  Two  Pies,  or  2500 
Points.  Game  play  is  identical  for  each  game,  although  the 
goal  is  different.  To  select  a  game,  press  one  of  the  number 
keys  (1-4)  from  the  keyboard  or  the  numeric  keypad.  The 
standard  game  is  Capture  All,  which  you  select  by  pressing 
the  1  key. 

Levels  of  Happiness 

The  screen  is  divided  into  three  parts:  the  big  map,  the  small 
map,  and  the  scoreboard.  The  small  map  shows  you  which 
player  owns  which  territories.  The  big  map  on  the  left  con- 
tains the  most  important  information;  it  tells  you  the  relative 
levels  of  happiness  within  each  household  in  the  city  of 
Karma.  Table  1-1  shows  the  color  of  the  moods  that  you'll  see. 

Table  1-1.  The  Color  of  Moods  in  Karma 


?vel 

Mood 

Color 

1 

2 
3 

Gloomy 
Content 
Pleased 

Deep  Blue 
Deep  Purple 
Maroon 

4 

5 

Joyous 
Ecstatic 

Red 
Bright  Red 

The  black  player  moves  first;  white,  second.  During  your 
turn,  you  may  move  the  mouse  pointer  to  any  household  on 
the  big  map,  but  the  household  must  be  on  your  side.  Click 
the  left  button  once  (you  may  have  to  hold  down  the  button 
for  a  second  or  two  to  make  sure  the  click  registers). 

Whichever  block  you  select  will  instantly  increase  one 
step  in  happiness.  A  blue  transforms  to  purple,  purple  be- 
comes maroon,  and  so  on. 

It  may  strike  you  that  you're  not  gaining  a  lot  of  popular- 
ity if  you  can  give  happy  points  only  to  the  households  that 
are  already  on  your  side.  You  click  the  mouse  pointer  on  your 
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followers,  and  your  opponent  clicks  on  his  or  her  followers. 
How  do  you  move  into  neutral  (or  unfriendly)  territory?  Good 
question. 

The  Power  of  Gossip 

The  levels  of  glee  stop  at  ecstatic;  there  is  no  more  blissful 
state.  That's  because  ecstasy  has  a  curious  effect  on  the  citi- 
zens of  Karma.  When  their  happiness  hits  level  5,  they  imme- 
diately tell  all  of  their  next-door  neighbors.  This  is  known  as  a 
gossip  explosion.  Three  things  happen:  The  ecstatic  household 
drops  back  down  to  a  lower  level  of  glee  (1,  2,  or  3,  depend- 
ing on  the  type  of  house),  but  at  the  same  time,  each  of  the 
neighbors  jumps  up  one  level  in  happiness.  The  neighbors 
also  move  over  to  your  side.  If  you  watch  the  two  maps, 
youTl  see  the  happy  colors  change  on  the  big  map.  YouTl  also 
see  your  own  color  spread  outward  on  the  smaller  map.  Table 
1-2  shows  the  colors  for  each  player. 

Table  1-2.  The  Players  and  Their  Colors 

Player  Color 

Player  1  Black 

Player  2  White 

Neutral  Gray 

As  the  game  begins,  a  majority  of  cells  are  neutral,  but  once  a 
household  is  converted  to  one  side  or  the  other,  it  can  never 
again  become  neutral. 

You  win  and  lose  games  by  controlling  strategically  lo- 
cated joyous  households.  If  you  click  on  a  red  piece,  it  affects 
all  of  the  neighboring  pieces.  If  a  neighbor  is  also  joyous,  it 
explodes.  It's  fairly  common  to  see  long  strings  of  chain  reac- 
tions as  gossip  spreads  through  a  block  of  neighbors  and  grad- 
ually affects  every  house  in  the  city. 

As  you  plan  your  strategy,  remember  this:  If  you  own  a 
joyous  Karmalite,  color  red,  and  your  own  Karmalite  lives  next 
door  to  another  joyous  Karmalite  on  your  enemy's  side,  either 
one  of  you  can  capture  both  of  them  (plus  all  of  their  neighbors). 
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From  Condos  to  Suburbs 

The  city  of  Karma  offers  elegant  living  arranged  as  four  types 
of  dwelling  units  as  shown  in  Table  1-3. 


Table  1-3.  Points  for  Happiness 


Unit 

Points 

Minimum  Happiness 

Condos 

3 

Content/2 

Houses 

4 

Gloomy/ 1 

Ranches 

4 

Gloomy/ 1 

Estates 

2 

Pleased/3 

The  condos  appear  on  the  screen  as  four  pie-shaped  units 
of  eight  wedge-shaped  condos.  Each  condo  has  three  neigh- 
bors and  is  worth  three  points.  A  group  of  eight  condos  looks 
circular  like  a  pie  and  is  commonly  referred  to  as  a  condo  pie. 

Houses  and  ranches  have  four  neighbors  and  a  value  of  4. 
There  are  nine  houses,  which  are  square  in  shape.  The  house 
at  the  very  top  of  the  city  is  connected  with  the  house  on  the 
southern  edge.  Likewise,  the  east  and  west  houses  are  neigh- 
bors. The  eight  ranches  are  the  five-sided  shapes  on  the  fringe 
of  Karma.  Each  ranch  borders  on  two  houses,  one  condo,  and 
an  estate. 

In  the  outer  corners,  youTl  see  the  four  estates.  They  have 
only  two  neighbors  (both  of  which  are  ranches)  and  are  worth 
two  points. 

Scoring  and  Winning 

At  the  end  of  each  turn,  both  players  are  awarded  popularity 
points  according  to  which  households  they've  swayed  to  their 
sides.  The  points  accumulate  as  the  game  progresses.  If  you 
control  12  condos,  three  houses,  a  ranch,  and  two  estates, 
you'll  gain  56  points:  (12  X  3)  +  (3  X  4)  +  (1  X  4)  +  (2  X  2). 

Underneath  the  score  is  a  second  number  that  indicates 
how  many  households  are  on  your  side.  If  this  number  dwin- 
dles to  0,  the  game  automatically  ends,  because  you  can  only 
click  on  households  you  currently  own.  If  you  don't  own  any, 
you  can't  make  a  move. 

In  the  first  three  games,  the  points  are  irrelevant,  except 
to  provide  the  loser  with  some  consolation  in  the  case  that  he 
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Figure  1-4.  The  Karma  Playfield 


There  are  four  types  of  properties  in  "Karma." 

or  she  loses  while  leading  in  points.  The  fourth  game  (2500 
points)  is  just  what  you  might  think.  The  first  person  to  reach 
2500  wins. 

In  game  1  (Capture  All),  the  goal  is  to  send  your  oppo- 
nent packing.  As  soon  as  one  player  has  no  more  friendly 
households,  the  game  ends. 

Game  2  (Two  Pies)  takes  a  little  less  time,  since  the  pur- 
pose is  to  capture  two  complete  eight-unit  condo  pies.  There 
are  four  condo  blocks,  so  you  might  believe  a  tie — two  blocks 
each — could  happen,  but  it's  impossible.  Say  player  1  made  a 
move  that  yielded  complete  control  of  two  blocks  (16  condos) 
and  that  the  other  player  also  owned  two  blocks  at  the  end  of 
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the  turn.  Player  2  can't  capture  any  cells  during  player  l's 
turn,  so  for  a  tie  to  occur,  player  2  would  have  had  to  own 
two  complete  blocks  before  player  1  started  his  or  her  turn. 
But  in  that  case,  player  2  would  have  won  the  game  before 
player  one  moved  the  mouse.  Ties  are  impossible. 

In  the  Four  Corners  game  (game  3),  your  aim  is  to  capture 
all  four  corner  estates.  Each  corner  has  only  two  neighbors,  so 
this  is  a  game  where  defense  is  crucial.  Once  you  control  a 
corner,  you  can — and  should  try  to — hold  on  to  it  for  as  long 
as  you  can. 

Strategies  and  Tactics 

The  joyous  households  are  on  the  verge  of  exploding  with 
gossip,  so  watch  them.  At  the  beginning  of  Karma,  you  may 
want  to  set  off  several  strategic  explosions,  in  order  to  gain 
more  territory  to  develop. 

In  the  middle  game,  push  a  few  isolated  cells  (households 
in  an  unhappy  neighborhood)  up  to  the  red  level  and  then 
leave  them  as  an  investment  in  the  future.  There's  nothing 
worse  than  setting  off  a  chain  reaction  that  leaves  the  board  in 
a  situation  where  your  opponent  simply  replies  with  another 
chain  reaction  that  decimates  your  troops.  If  you  have  nothing 
but  blues,  you  can't  do  much  to  get  back. 

The  final  few  moves  are  crucial.  You'll  often  see  a  city 
where  one  move  creates  a  small  chain  reaction,  while  another 
move  removes  your  opponent  from  play. 

Although  reds  are  primed  to  explode,  maroons  will  often 
receive  gossip  from  two  directions.  If  three  reds  are  immediate 
neighbors,  all  three  will  explode.  If  a  maroon  is  next  to  two  of 
the  reds,  it  will  receive  gossip  from  two  directions  and  will 
also  explode. 
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Karma 

Filename:  KARMA 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B,  "COM- 
PUTER'S Guide  to  Typing  In  Amiga  Programs." 

'Copyright  1987* 

'COMPUTE!  Publications,  Inc.* 

'All  Rights  Reserved. 4 

4 

DEFINT  a-zsDEFSNG  r,g,b4 

DIM  sides(52) ,xcord (52,5) , ycord (52,5) , numad jacents(5 

2) , nei  ghbors (52, 3) 4 

DIM  owner (52) , renter (52) , update (52) , start (20) , xf  i nd ( 

52),yfind(52)4 

DIM  r(15),g(15),b(15),ToDo(100)4 

gamenum-14 

4 

RANDOMIZE  TIMER* 

4 

SCREEN  1,320, 200, 4,1: WINDOW  3, "", (0,0) -(311 , 186) , 16, 

1: WINDOW  OUTPUT  34 

4 

newgame:4 

4 

COLOR  1 , 0: CLSa  score ( 1 ) -10: score (2) -104 

COLOR  1,2: LOCATE  8, 13: PRINT"      Karma      "4 

COLOR  1,0: PRINT: PRINT"   Copyright  1987  Compute!  Publ 

.,  Inc. "4 

PRINT"  All  Rights  Reserved "4 

PRINT: PRINT: COLOR  1,24 

PRINT"  Choose  game.  ": COLOR 

0, 1:PRINT4 
4 

PRINT  "  1.  Capture  All  "4 

PRINT  "  2.  Four  Corners  "4 

PRINT  "  3.  Two  Pies  "4 

PRINT  "  4.  2500  Points  "4 

4 

GetAKey:4 

a*-INKEY*:IF  a*-""  THEN  GetAKey4 
IF  a*<"l"  OR  a*>"4"  THEN  GetAKey4 
gamenum-VAL(a*): LOCATE  21,19:PRINT  "  "a*"  "  4 
4 

RESTORE  -findpoints4 
FOR  i-0  TO  524 

READ  x,y:x-find(i)=x*10:yfind(i)-y*104 
NEXT  i4 
4 

RESTORE  Karma4 
FOR  i-0  TO  524 

READ  sides(i)4 
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FOR  ii-0  TO  sides<i>-24 
READ  xc,yc4 

xcord<i,ii)«xc*12  4 

ycord<i,ii)-yctl24 

NEXT   ii4 

READ  numadjacentsd  )4 

FOR  ii-0  TO  numadjacent*<i>-14 
READ  neighbor*<i,ii>4 

NEXT  ii4 
NEXT  14 
4 

RESTORE  thecolors4 
FOR  i-0  TO  154 

READ  r,g,b:r<i)«r/100:g<i)«g/100:b<i)«b/1004 

PALETTE  ifr(i),g(i)fb(i)4 
NEXT  14 
4 

thecolors:4 
4 

DATA  50,40,304 
DATA  16, 16, 164 
DATA  0,0,0   4 
DATA  0,5,404 
DATA  25,5,304 
DATA  50,5,204 
DATA  75,5,104 
DATA  100,5,04 
DATA  100,55,04 
DATA  30,30,304 
DATA  0,0,04 
DATA  70,70,704 
DATA  0,0,04 
DATA  0,0,04 
DATA  0,0,04 
DATA  0,0,04 
4 

COLOR  1,0: FOR  i-0  TO  24: PRINT: NEXT  14 
4 

LOCATE  1,8: COLOR  10, 11:PRINT"  K  a  r  m  a  "4 
COLOR  11, 10: LOCATE  1,254 
4 

IF  gam»num-l  THEN  PRINT  "  Capture  All  "4 
IF  gamenum-2  THEN  PRINT  "  Four  Corners  "4 
IF  gam«num-3  THEN  PRINT  "  Two  Pies  "4 
IF  gamenum«4  THEN  PRINT  "  2500  Points  "4 
4 

RESTORE  start4 
FOR  i-0  TO  194 

READ  start <i) 4 
NEXT  i4 
4 
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starts  4 

DATA  4, 13, 5, 14,11, 15, 23, 33, 24, 34, 25, 35, 18, 8, 30, 20, 37 

,36,39,38  4 

4 

FOR  i=0  TO  524 

owner  (i  )«0: renter  (i  )=»0:  update  (i  )«04 
NEXT  14 
4 
FOR  i-0  TO  19  4 

owner (start (i) )  =  (i  AND  1 ) +1: renter (start (i )) =14 
NEXT  i4 
4 
FOR  i=0  TO  524 

QOSUB  Do0ne4 
NEXT  14 
4 

pi ayer=2: play* ( 1 ) ="bl ack " : pi  ay* (2) ="whi  te"4 
4 

game: 4 
4 

p  1  ayer -3-p  1  ayer  4 

LOCATE  7, 25: COLOR  9+pl ayer, 9: PRINT  "  "; play* (player) 
;"'s  turn  "4 
4 
4 
4 

1 oop : 4 
4 

WHILE  MOUSE (0)-0:WEND4 

x -MOUSE ( 1 ) : y«MOUSE (2) : hue-POINT (x , y ) 4 
IF  hue<3  OR  hue>8  THEN  loop4 
PALETTE  15, r (hue), g (hue), b (hue) 4 
PAINT  (x,y), 15,24 
4 

which— 14 
FOR  1-0  TO  524 

IF  P0INT(xfind(l),yfind(i))-15  THEN  which«14 
NEXT  i4 

IF  which<0  THEN  ST0P4 
4 

IF  owner  (which)  Op  layer  THEN  PAINT  (x,y)  ,  hue,  2:  GOTO 
loop  4 
4 

SOUND  WAIT4 

SOUND  130, 10,, 0: SOUND  130.5, 10,, 24 
SOUND  RESUME4 
4 
FOR  real-0  TO  1  STEP  .024 

h«hue:r«real4 

PALETTE  15, r (h)+.25*r, .05,b(h)-. I*r4 
NEXT  real 4 
4 
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Max  ToDo-04 

4 

again: 4 

4 

renter  (which) ■'renter  (which)  +14 

IF  renter (which) +1 >numadjacents( which)  THEN  4 

FOR  i-0  TO  numadjacents (which) -14 
Max  ToDo-Max  T0D0+ 1 : t =nei ghbor s ( wh  i  ch , i ) 3 T0D0 (Max  ToD 
o)-t4 

REM   PAINT  (xfind(t) ,yfind(t) ) ,POINT(xf ind (t) , yf in 
d(t))+l,24 

NEXT  i: SOUND  WAIT: SOUND  200+whi ch* 16, 1 ,  , 0: SOUND  200 
+which*8,l,,2:S0UND  RESUME  4 

renter ( whi  ch ) -renter ( whi  ch ) -numadjacents ( whi  ch ) 4 
END  IF  4 
4 

i-which4 

IF  owner (i )-3-p layer  THEN  score (3-player ) -score (3-pl 
ayer)-14 

IF  owner  (i  )  Op  layer  THEN  score  (player) -score  (player) 
+  14 
owner (i) -player : BOSUB  DoOne: SOUND  200+6*which, . 15,80 

IF  scored  )-0  OR  score (2) -0  THEN  gameover4 
IF  MaxToDo<>0  THEN  which-ToDo(MaxToDo) :MaxToDo»MaxTo 
Do-1:QOTO  again4 
4 

WHILE  MOUSE  (0X0:  WEND4 
4 

IF  gamenum-2  AND  ( (owner (0)  AND  owner (1)  AND  owner (2 
)  AND  owner(3))<>0)  THEN  gameover4 
IF  gamenum-3  THEN4 
win 1-0: win2-04 
FOR  j-0  TO  34 
garbage-owner ( j  *8+4 ) 4 
FOR  k-1  TO  74 

garbage-owner (j*8+4+k)  AND  garbage4 
NEXT  k4 

IF  garbage-1  THEN  winl-winl+14 
IF  garbage-2  THEN  win2-win2+14 
NEXT  j4 

IF  winl>-2  OR  win2>-2  THEN  gameover4 
END  IF    4 
FOR  j-1  TO  24 
FOR  i-0  TO  524 
IF  owner (i)-j  THEN  points ( j ) -points ( j ) +numad jacent 
s(i)4 

NEXT  i4 
NEXT  j4 

LOCATE  23, 25: COLOR  10,0: PRINT  points (1)4 
LOCATE  23, 32: COLOR  11,0: PRINT  points (2) 4 
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IF  gamenum=4  AND  (points( 1 ) >2499  OR  points (2) >2499) 
THEN  gameover4 

4 
GOTO  garnet 
4 

SCREEN  CLOSE  14 
4 

SOTO  doIt4 
4 

END4 
4 

Do0ne:4 
4 

si 2-si des ( i ) -2: COLOR  7- (numad  jacents ( i ) -renter ( i ) ) , 0 
4 

AREA  (xcord  (i  , si 2) +12, ycord (i , si 2) +12)4 
FOR  ii-0  TO  si 24 

AREA  (xcord (i , i  i ) +12, ycord ( i , i  i ) +12) 4 
NEXT  ii4 
AREAFILL4 
COLOR  2,14 

PSET  (xcord ( i, si 2) +12, ycord (i, si 2) +12) 4 
FOR  ii*0  TO  si  24 

LINE  -(xcord(i,ii)+12,ycord(i,ii)+12)4 
NEXT  ii4 
4 

Do0ne2:4 
4 

si  2«si  des ( i ) -2: COLOR  owner ( i ) +9 , 1 4 
AREA  (xcord ( i , si  2) /2+202, ycord ( i , si  2) /2+90) 4 
FOR  ii=0  TO  si  24 

AREA  (xcord ( i , i  i ) /2+202, ycord ( i , i  i ) /2+90) 4 
NEXT  ii4 
AREAFILL4 
COLOR  1,14 

PSET  (xcord (i , si  2) /2+202, ycord (i , si  2) /2+90)4 
FOR  ii=0  TO  si 24 

LINE  - (xcord ( i , i  i ) /2+202, ycord ( i , i  i ) /2+90) 4 
NEXT  ii4 
RETURN4 
4 

gameover : 4 
FOR  i=0  TO  524 

60SUB  Do0ne24 
NEXT  i  4 
FOR  i-0  TO  404 

FOR  j*0  TO  34 
SOUND  RND*i*10,2,,  j4 

NEXT  j4 
NEXT  i   4 
FOR  i»40  TO  0  STEP  -14 
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FOR    j»0    TO    34 

SOUND  RND*i*10,2,, j4 
NEXT  j4 
NEXT  i   4 

FOR  i-0  TO  10000: NEXT  14 
RUN4 
4 

Karma: 4 
4 

1,1,  4,1,  3,3,  1,44 
43,444 


DATA  5 
DATA  2 
4 

DATA  5 
DATA  2 
4 

DATA  5 
DATA  2 
4 

DATA  5 
DATA  2 
4 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 
4 
4 

DATA  4 
DATA  3 
4 

DATA  4 
DATA  3 


10,1,  13,1,  13,4,  11,34 
45,464 

11,11,  13,10,  13,13,  10,134 
40,474 

1,10,  3,11,  4,13,  1,134 
41,424 


6,2,  8,2,  7,44 
5,11,394 

8.2,  9,3,  7,44 
4,6,454 

9.3,  9,5,  7,44 
5,7,504 

9.5,  8,6,  7,44 
6,8,194 

8.6,  6,6,  7,44 
7,9,524 

6,6,  5,5,  7,44 
8,10,294 

5,5,  5,3,  7,44 
9,11,494 


5,3,  6,2,  7,44 
4,10,444 


9,5,  11,5,  10,74 
13,19,504 

11,5,  12,6,  10,74 
12,14,464 
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4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 
4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 

4 

DATA 

DATA 

4 

DATA 

DATA 

4 


12,6,  12,8,  10,74 
13,15,364 

12.8,  11,9,  10,74 
14,16,474 

11.9,  9,9,  10,74 
15,17,514 

9,9,  8,8,  10,74 
16,18,214 

8,8,  8,6,  10,74 
17,19,524 

8,6,  9,5,  10,74 
7,12,184 


6,8,  8,8,  7,104 
21,27,524 

8.8,  9,9,  7,104 
17,20,224 

9.9,  9,11,  7,104 
21,23,514 

9.11,  8,12,  7,104 
22,24,404 

8.12,  6,12,  7,104 
23,25,374 

6,12,  5,11,  7,104 
24,26,414 

5,11,  5,9,  7,104 
25,27,484 

5,9,  6,8,  7,104 
20,26,314 


3,5,  5,5,  4,74 
29,35,494 

5,5,  6,6,  4,74 
9,28,304 
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DATA  4, 

DATA  3, 

4 

DATA  4, 

DATA  3, 

4 

DATA  4, 

DATA  3, 

4 

DATA  4, 

DATA  3, 

4 

DATA  4, 

DATA  3, 

4 

DATA  4, 

DATA  3, 

4 

4 

DATA  5, 

DATA  4, 

4 

DATA  5, 

DATA  4, 

4 

DATA  5, 

DATA  4, 

4 

DATA  5, 

DATA  4, 

4 

4 

DATA  6, 

DATA  4, 

4 

DATA  6, 

DATA  4, 

4 

DATA  6, 

DATA  4, 

4 

DATA  6, 

DATA  4, 

4 

DATA  6, 

DATA  4, 

4 

DATA  6, 

DATA  4, 

4 

DATA  6, 

DATA  4, 


6,6,  6,8,  4,74 
29,31,524 

6.8,  3,9,  4,74 
27,30,324 

5.9,  3,9,  4,74 
31,33,484 

3,9,  2,8,  4,74 
32,34,424 

2,8,  2,6,  4,74 
33,35,384 

2,6,  3,5,  4,74 
28,34,434 


12,6,  14,6,  14,8,  12,84 
14,38,46,474 

6,12,  8,12,  8,14,  6,144 
24,39,40,414 

0,6,  2,6,  2,8,  0,84 
34,36,42,434 

6,0,  8,0,  8,2,  6,24 
4,37,44,454 


9,11,  11,11,  10,13,  8,14,  8,124 
2,23,37,514 

3,11,  5,11,  6,12,  6,14,  4,134 
3,25,37,484 

0,8,  2,8,  3,9,  3,11,  1,104 
3,33,38,484 

1,4,  3,3,  3,5,  2,6,  0,64 
0,35,38,494 

4,1,  6,0,  6,2,  5,3,  3,34 
0,11,39,494 

8,0,  10,1,  11,3,  9,3,  8,24 
1,5,39,504 

11,3,  13,4,  14,6,  12,6,  11,54 
1,13,36,504 
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4 

DATA  6,  12,8,  14,8,  13,10,  11,11,  11,94 

DATA  4,  2,15,36,514 

4 

4 

DATA  5,  3,9,  5,9,  5,11,  3,114 

DATA  4,  26,32,41,424 

4 

DATA  5,  3,3,  5,3,  5,5,  3,54 

DATA  4,  10,28,43,444 

4 

DATA  5,  9,3,  11,3,  11,5,  9,54 

DATA  4,  6,12,45,464 

4 

DATA  5,  9,9,  11,9,  11,11,  9,114 

DATA  4,  16,22,40,474 

4 

4 

DATA  5,  6,6,  6,8,  8,8,  8,64 

DATA  4,  8,18,20,304 

4 

-f  indpoints:4 

4 

DATA  4,4,  16,5,  16,15,  4,154 

DATA  10,4,  11,5,  11,6,  11,7,  10,8,  9,7,  8,6,  9,54 

DATA  13,8,  14,9,  15,10,  15,11,  13,11,  12,11,  12,10, 

12,84 

DATA  10,11,  11,12,  11,13,  11,15,  10,15,  9,14,  8,13, 

8,  124 

DATA  6,8,  7,9,  8,10,  8,11,  6,11,  5,11,  5,10,  5,84 

DATA  17,10,  10,17,  3,10,  10,34 

DATA  13,16,  7,16,  4,13,  4,7,  7,3,  12,3,  16,7,  16,124 

DATA  6,13,  6,6,  13,6,  13,134 

DATA  10, 104 

4 
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Rememory 

Charles  Harbert 
Translation  by  Tim  Midkiff 


How  good  is  your  memory?  Find  out  for  sure  as 

you're  tested  by  the  Amiga  in  this  Concentration- 

style  thinking  game.  Your  goai:  match  the  pairs  of 

colorful  graphic  images  with  one  another. 

"Rememory"  Jets  you  test  your  powers  of  recall 

against  the  computer  or  a  friend. 

"Rememory"  is  a  game  that  will  push  your  powers  of  con- 
centration and  memorization  to  the  limit.  Type  in  the  program 
listed  and  save  it.  When  you're  ready  to  play,  simply  load  and 
run  the  program. 

Playing  Rememory 

Rememory  is  played  on  a  grid  containing  54  boxes  arranged  in 
a  9  X  7  matrix.  Each  box  contains  a  graphics  shape,  and  there 
are  many  matching  shapes  within  the  grid.  The  object  of  the 
game  is  to  find  all  of  the  matches  in  the  playing  grid  by  select- 
ing any  two  boxes  at  a  time. 

The  mouse  pointer  indicates  your  current  position  on  the 
game  screen.  Move  the  mouse  pointer  to  the  desired  box  and 
press  the  left  mouse  button  to  select  it.  When  you  click  on  the 
box,  the  computer  displays  the  shape  which  it  contains.  In  the 
two-player  game,  the  colors  of  the  window  border  change  to 
indicate  whose  turn  it  is.  To  add  to  the  interest  and  difficulty, 
the  program  uses  color  cycling  to  change  the  colors  of  the 
graphics  shapes. 

A  turn  consists  of  two  selections.  After  you  select  both 
boxes,  the  computer  displays  both  of  them  briefly.  If  the  two 
shapes  you  select  are  identical,  you  have  scored  one  match,  and 
those  shapes  remain  visible  on  the  board.  If  the  shapes  do  not 
match,  the  computer  erases  them,  and  it's  your  job  to  remem- 
ber where  those  shapes  were  located.  The  computer  scrambles 
the  shapes  at  the  beginning  of  each  game,  so  you  won't  know 
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where  a  given  shape  is  found  until  you  uncover  it. 

Rememory  can  be  played  with  one  or  two  players.  When 
you  play  alone,  the  object  is  to  match  all  the  shapes  in  the 
fewest  number  of  turns.  For  a  two-player  game,  the  goal  is  to 
score  more  matches  than  your  opponent.  You  get  an  extra  turn 
every  time  you  succeed  in  making  a  match.  If  you  set  a  time 
limit  for  each  move  (for  instance,  20  or  30  seconds), 
Rememory  can  be  a  fast-paced,  exciting,  two-player  game. 

When  you  run  the  program,  it  asks  how  many  players 
will  play  the  game.  Enter  the  number  of  players — either  1  or 
2.  Then  the  program  asks  how  many  matches  will  be  required 
to  finish  the  game.  If  you  enter  the  maximum  number,  27,  you 
will  have  to  match  every  pair  of  shapes  in  the  grid  to  finish.  If 
you  choose  a  lower  number,  the  game  ends  when  you  achieve 
the  designated  number  of  matches.  The  right  side  of  the 
screen  displays  the  current  score. 

Rememory 

Filename:  REMEMORY 

For  instructions  on  entering  this  program,  pJease  refer  to  Appendix  B,  "COM- 
PUTER'S Guide  to  Typing  In  Amiga  Programs." 

*   Copyright  1987  COMPUTE!  Publications,  Inc. 4 
9       All  Rights  Reserved* 

<r 

DEFINT  a-z:DEFSNG  r, g, b, mx : RANDOMIZE  TIMER: SCREEN  1, 

320,200,5, 14 

WINDOW  3,  ,,M,  (0,0) -(311,  186)  ,  16,  1:  WINDOW  OUTPUT  34 

DIM  bn(5,8)  ,cb(26)  ,  r  <  1 1 )  ,  b  <  1 1 )  ,  df  (7)  ,  aLt  (7),  nor  (7)  ,v 

er (7) ,sL(7) ,rn(7) ,ck(7)4 

RESTORE  PaletteData:FOR  i«0  TO  15: READ  r,g,b: PALETTE 

i,r,g,b:NEXT4 
FOR  i=20  TO  21:READ  r, g, b: PALETTE  i , r, g, b: NEXT4 
FOR  i»0  TO  5:READ  r (i ), b <i ): PALETTE  i+22, r (i ) , 0, b (i ) 
:NEXT4 

FOR  i=0  TO  5:r <ll-i)«b<i):b(ll-i)=r(i):NEXT4 
PaletteData:  4 

DATA  0,0,0, .5, .5, .5, .5, .5, .5, .6,0,04 
DATA  0, .6,0,. 6,. 6,0,. 6,0,. 6,0,. 6,. 64 
DATA  0,0,. 6,. 9,. 9,. 9,. 9, 0,0,0,. 9,  04 
DATA  0,0, .9, .9, .9,0, .9,0, .9, .5, .5, .54 
DATA  0,0,0,0,0,04 

DATA  .6,0, .8,0, 1,0, .8,0, .6,0, .5, .34 
FOR  i«0  TO  26: READ  cb<i):NEXT4 

DATA  9,4, 13, 15,3,0,9,6, 12,9,4,20, 13,0,0,0,22, 12,9, 13 
,15, 15,9,8,9,3, 104 
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e*=SPACE*<3):0N  TIMER (1)  GOSUB  CycLe* 

FOR  i=0  TO  7* 

df  ( i  )  =S<HFFFF :  ver  ( i  )  =&HAAAA:  rn  ( i  )  =RND*S<HFFFF* 

IF  (i  AND  1)  THEN  nor  <i  )  =&HFFFF:  aLt  <i  )=S«HAAAA  ELSE  a 

Lt(i)=S«H5555* 

IF  (i  AND  4)  THEN  ck <i ) =&HF0F0  ELSE  c  k  <  i  )  =S<HF0F* 

NEXT* 

FOR    i«0   TO   3:READ   sL (i ) : sL (i+4) =*L(i ) :NEXT* 

DATA   &H3333,  MH6666,  Sthcccc,  &H9999* 

Start:* 

COLOR  2,0:CLS: GOSUB  I nPLayere: LOCATE  13, 9: GOSUB  InMa 

tehee* 

GOSUB  RandBoard:mf«0:ts«0:FOR  i=0  TO  1: tr (i )-0:»c (i ) 

«0:NEXT* 

GOSUB  DrawBoard:pL«0:m«l:sw«0: TIMER  ON* 

WHILE  ts<nm* 

IF  np  THEN  PALETTE  1 , . 6* ( 1-pL) , . 6*pL,0* 

GOSUB  Select  Box:  GOSUB  ShowPic:rl«ro:cl*»co:  GOSUB  Sele 

ctBox: GOSUB  ShowPic* 

IF  bn(rl,cl)=bn(ro,co)  THEN* 

sc  (pL)  "sc  (pL)  +1 :  ts«=ts+l :  m=0* 

ELSE* 

FOR  i=l  TO  4000: NEXT: GOSUB  HidePic* 

END  IF* 

tr <pL)=tr <pL)+l: GOSUB  UpdateScore: IF  m  THEN  pL*pL  XO 

R  np* 

m«l* 

WEND* 

COLOR  15,0: LOCATE  9, 10: PRINT  "Another  game  (y/n)?M* 

EndLp:  k*-UCASE*< INKEY*) : IF  k*=MY"  THEN  Start* 

IF  k*="NM  THEN  TIMER  OFF: SCREEN  CLOSE  1: WINDOW  CLOSE 

3: END  ELSE  EndLp* 
* 

Select Box:* 

WHILE  MOUSE (0) "0: WEND: px»MOUSE ( 1 ) s py=MOUSE (2) : WHILE 
MOUSE (0) <>0: WEND* 

IF  POINT (px,py)<>2  THEN  SelectBox* 

px=*px  AND  SeHFFE0:py=py  AND  &HFFE0:ro=INT  <py/32)  :co«I 
NT(px/32):py=py+8  * 

RETURN* 
* 

ShowPic:* 

n»bn(ro, co): COLOR  ,cb(n): GOSUB  Hide* 

ON  n+1  GOTO  1,1,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, 
16, 17, 18, 19,20,21,22,23,24, 1* 
LOCATE  cy, ex: PRINT  STR* (bn (ro, co) ) * 

1  RETURN* 

2  COLOR  0: LOCATE  cy+1 , cx+1 : PRINT  CHR* (214) : PAINT <px+ 
12, py+12): RETURN* 

3  COLOR  13: a*«CHR* < 191 ) +CHR* (63): LOCATE  cy, ex: PRINT 
a*CHR*(19D* 
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LOCATE  cy+1, ex: PRINT  CHR* (63) a*: LOCATE  cy+2, ex : PRINT 
a*CHR*(191);:RETURN  * 

4  PATTERN  ,sL:FOR  i»0  TO  7: COLOR  i+7* 

LINE  (px+2*i , py+2*i ) - (px+23-2*i , py+23-2*i ) , , bf : NEXT: P 
ATTERN  ,df: RETURN* 

5  COLOR  10: AREA (px+2,py+12): AREA  STEP ( 10, -10) : AREA  S 
TEP(10, 10)4 

AREA  STEP (-10, 10): AREA  STEP (-10, -10) : PATTERN  ,hor:AR 
EAF ILL: PATTERN  ,df: RETURN* 

6  COLOR  14:B0SUB  Triangle: AREAF ILL: RETURN  * 

7  COLOR  13: CIRCLE (px+19,py+5), 2: PAINT (px+20,py+5)* 
PATTERN  ,sL: GOSUB  Triangle: AREAF ILL: PATTERN  ,df:RETU 
RN* 

8  COLOR  ,3: LOCATE  cy, cx+1 : PRINT  SPACE* ( 1 ): LOCATE  cy+ 
1, ex: PRINT  e** 

LOCATE  cy+2, cx+1: PRINT  SPACE* ( 1 );: RETURN* 

9  FOR  i=0  TO  2:F0R  j»0  TO  2:C0L0R  20+((i+j)  AND  l):x 
«px+5*i+7:y«py+5*j+7* 

CIRCLE (x,y), 2: NEXT  j,i: RETURN* 

10  COLOR  21:G0SUB  Box: PATTERN  , aLt: AREAF ILL: PATTERN 
,df: RETURN* 

11  COLOR  6:G0SUB  Box : PATTERN  , sL: AREAF ILL: PATTERN  ,d 
f : RETURN* 

12  COLOR  14: PATTERN  ,hor :x=px+4:y=py+4: BOSUB  Diamond 
: AREAF ILL* 

x=px : y=py+12: GOSUB  Di amond: AREAF ILL* 

x=px+12:y=py +16: GOSUB  Diamond: AREAF ILL: PATTERN  ,df:R 

ETURN* 

13  FOR  i=0  TO  ll:COLOR  (i  MOD  6) +22: LINE (px , py+2«i ) - 
(px+23,  py+23-2*i  )  :  NEXT* 

RETURN* 

14  FOR  i«0  TO  ll:COLOR  (i  MOD  6) +22: LINE (px , py) - (px+ 
2*i,py+23-2*i)* 

LINE (px+23, py+23) - (px+2*i , py+23-2*i ) : NEXT: RETURN* 

15  COLOR  24: GOSUB  Box: PATTERN  , aLt: AREAF ILL: COLOR  ,0 
* 

LOCATE  cy+1, cx+1: PRINT  SPACE* ( 1 ): PATTERN  ,df: RETURN* 

16  COLOR  20:x=px+8:y=py+12:GOSUB  Diamond: AREAF ILL: x= 
x+4* 

CIRCLE (x , y ) , 2, 21 : PAINT (x , y ) , 21 , 21 : RETURN* 

17  COLOR  12: GOSUB  Triangle: PATTERN  ,ver: AREAF ILL: PAT 
TERN  ,hor: COLOR  9,12* 

AREA (px,py): AREA  STEP (23, 0) : AREA  STEP (0, 23) : AREA  STE 

P(-23,-23)* 

AREAF I LL : PATTERN  , df : RETURN* 

18  PATTERN  ,rn: PAINT (px , py) , 22, 0: PATTERN  , df : RETURN* 

19  PATTERN  , ck: PAINT (px , py) , 0, 0: PATTERN  ,df: RETURN* 

20  COLOR  15, 0: LINE (px,py+7)- (px+23, py+7) ,0* 

LOCATE  cy+1, ex: PR I NT  CHR* (240) CHR* (245) CHR* (240) : RET 
URN* 


39 


CHAPTER  ONE 


21  FOR  i=l  TO  ll:LINE(px,py+i*2)-(px+23,py), 104 
LINE (px , py+23) - (px+23, py+i  *2> , 12: NEXT: RETURN* 

22  FOR  i=4  TO  20:LINE <px , py+i )- (px+23, py+i ) , <i  MOD  4 
) +28: NEXT: RETURN* 

23  COLOR  0:LINE(px,py+17)-(px+6,py+9):LINE  -STEP(6,2 
):LINE  -STEP (6, 6) 4 

LINE  -STEP(5,0) :PAINT(px,py) , 0,0: LINE (px , py+16) - (px+ 

6,py+8)  ,284 

LINE  -STEP (6, 2), 29: LINE  -STEP (6, 6) , 30: LINE  -STEP (5,0 

),31:RETURN4 

24  LINE (px , py+8) - (px+23, py+16) , 0: PAINT (px , py+23) , 5, 0 
: RETURN4 

4 

Triangle: 4 

AREA (px,py): AREA  STEP (23, 23) : AREA  STEP (-23,0) : AREA  S 

TEP (0, -23) : RETURN4 

4 

Diamond: 4 

AREA (x,y): AREA  STEP (4, -4) : AREA  STEP (4, 4) : AREA  STEP(- 

4,4): AREA  STEP (-4, -4) 4 

RETURN4 

4 

Box:  4 

AREA (px,py): AREA  STEP (23, 0) : AREA  STEP (0, 23) z AREA  STE 

P(-23,0)4 

AREA  STEP ( 0 , -23 ) : RETURN4 

4 

HidePic:4 

COLOR  ,2:G0SUB  Hide: ro«rl :co-cl :GOSUB  Hide:RETURN4 

Hi de:  cx«4*co+l : cy»4*ro+24 

FOR  i«0  TO  2: LOCATE  cy+i , ex : PRINT  e*; :NEXT: RETURN4 

4 

UpdateScore: 4 

COLOR  0,pL+3:pr«8»pL-4*np+13: LOCATE  pr, 37: s*«STR* (tr 

(pL))4 

PRINT  RIGHT*  ( "00"+RIBHT*  (s*,  LEN  (s*)  -1 )  ,  3)  4 

LOCATE  pr+2,37:s*=STR*(sc(pL))4 

PRINT  RIGHT* ("00"+RIGHT* (s*, LEN (s*)-l) ,3)4 

RETURN4 

4 

DrawBoard:4 

CLS: COLOR  ,2: FOR  i-0  TO  234 

IF  (i  AND  3)<>0  THEN4 

FOR  j-0  TO  8: PRINT  e*SPC ( 1 ) ; : NEXT4 

END  IF4 

IF  i<23  THEN  PRINT4 

NEXT4 

FOR  pL«0  TO  np: COLOR  0,pL+3:FOR  j-0  TO  6: LOCATE  8*pL 

-4*np+10+j,374 

PRINT  e«: NEXT: LOCATE  8*pL-4*np+l 1 , 37: PRINT  STR*(pL+l 

):GOSUB  UpdateScore: NEXT4 
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RETURN* 

* 

RandBoard: 4 

i«0:FOR  j-0  TO  4  STEP  2:F0R  k-0  TO  8: bn < j, k)=i : bn < j+ 

l,k)-iii-i+liNEXT  k,j* 

FOR  j=0  TO  5: FOR  k«0  TO  8: sj=INT <RND*5> : sk=INT <RND*9 

>* 

t=bn  < s  j ,  sk  > :  bn  <s  j ,  sk >  =bn  ( j ,  k ) : bn  <  j , k ) =t :  NEXT  k ,  j  * 

RETURN* 

* 

InPLayers:* 

LOCATE  11, 9: PRINT  "Number  of  players  (1/2)?"* 

BetKey:k*=INKEY*:IF  k*=""  OR  (kSO"!"  AND  k*<>u2n)  T 

HEN  Get Key* 

np«VAL<k*)-l* 

RETURN* 

* 

InMatches:* 

INPUT  "Number  of  matches  (1-27)?  ",s** 

nm«VAL(sS):IF  nm<l  OR  nm>27  THEN  nm«27* 

RETURN* 

* 

CycLe:* 

nsw-sw  XOR  1: PALETTE  20, 0, sw*. 9,0: PALETTE  21,0,nsw*. 

9,0* 

sw=(sw+l)  MOD  2:cc»(cc+l)  MOD  12* 

FOR  cn=28  TO  31: PALETTE  en, 1, 1 , 1 :NEXT:P ALETTE  (cc  MO 

D  4)+28, 0,0,1* 

FOR  cn=0  TO  5:ck=<cc+cn>  MOD  12:PALETTE  cn+22, r <ck> , 

0,b(ck) :NEXT* 

RETURN* 
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Wari 

Don  Donati 
Translation  by  Pat  Parrish 


"Wari,"  based  on  an  ancient  strategy  game,  Jets  you 

match  your  wits  against  the  computer.  Move  the 
counters  around  the  board  and  capture  the  comput- 
er's pieces.  A  fineiy  detailed  BASIC  program,  Wari 
requires  weii-pianned  strategies  in  order  to  win.  The 
program  runs  on  any  Amiga  computer. 

Wari  is  a  strategy  game  which  has  been  played  for  centuries  in 
Africa  and  the  Middle  East.  The  object  of  the  game  is  to  cap- 
ture as  many  of  your  opponent's  pieces  as  you  can,  while  try- 
ing to  prevent  the  capture  of  your  own  pieces.  Type  in  the 
listing  and  save  a  copy  before  you  run  the  program. 

Electronic  Beans 

Wari  is  played  on  a  board  which  has  12  compartments  ar- 
ranged in  two  rows  of  6  (the  arrangement  is  similar  to  that  of 
an  egg  carton).  In  the  original  versions  of  this  game,  the  com- 
partments were  actual  depressions  in  a  board  or  simply  holes 
scooped  into  the  ground,  and  the  game  was  played  by  moving 
counters  (beans,  pebbles,  or  other  small  objects)  among  the 
various  compartments.  In  the  computerized  version  of  Wari, 
the  compartments  are  rectangles  drawn  on  the  screen,  and  the 
counters  are  represented  by  numbers.  If  the  number  4  appears 
in  a  compartment,  that  compartment  holds  four  counters,  and 
so  on. 

Six  of  the  compartments  are  yours  and  the  other  6  belong 
to  your  opponent,  which  is  always  the  computer.  When  the 
game  begins,  four  counters  are  placed  in  each  of  the  12  com- 
partments, for  a  total  of  48  counters.  You  each,  then,  start  the 
game  with  24  counters.  Once  play  begins,  however,  counters 
are  considered  yours  when  they  rest  in  one  of  the  6  compart- 
ments on  your  side  of  the  board.  Next,  the  program  asks 
whether  you  want  a  limited  game  or  an  unlimited  one.  For 
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limited  games,  a  maximum  number  of  moves  are  allowed. 
There's  more  about  that  below.  The  program  then  asks 
whether  you  or  the  computer  should  make  the  first  move. 

Counterclockwise  Movement 

A  move  consists  of  taking  all  the  counters  from  one  compart- 
ment on  your  side  of  the  board  and  sowing,  or  distributing, 
one  counter  into  each  of  the  adjacent  compartments  in  a  coun- 
terclockwise direction.  In  the  original  game,  this  was  done  by 
picking  up  the  counters  and  sowing  them  by  hand.  In  this  ver- 
sion of  Wari,  you  simply  indicate  which  compartment  you 
wish  to  sow  by  pressing  the  key  corresponding  to  the  letter 
printed  by  that  compartment.  The  computer  automatically 
sows  that  compartment's  counters  for  you  leaving  the  original 
compartment  empty. 

Depending  on  which  compartment  you  choose,  the  sow- 
ing can  wrap  around  from  one  side  of  the  board  to  the  other. 
Should  you  sow  12  or  more  counters,  you  return  to  the  com- 
partment where  you  started:  In  that  case,  the  original  compart- 
ment is  skipped  and  sowing  resumes  in  the  next  one. 

Captures 

You  score  points  in  Wari  by  capturing  counters.  A  capture  oc- 
curs when  you  sow  your  last  counter  in  the  computer  player's 
compartment  which  previously  contained  either  one  or  two 
counters.  The  counters  from  that  compartment  are  then  re- 
moved from  play.  Each  captured  counter  is  equal  to  one  point. 
If  the  previous  compartment  in  line  also  contains  two  or  three 
counters  at  the  end  of  the  move,  its  counters  are  captured,  as 
well.  This  process  continues  until  no  more  counters  can  be 
captured  in  that  turn.  In  some  cases,  it's  possible  to  capture  all 
of  the  computer's  counters  in  a  single  move. 

The  game  can  end  in  several  different  ways.  Play  must 
end  whenever  the  board  is  empty  (all  counters  have  been  cap- 
tured) or  whenever  one  player  has  no  more  counters  to  move. 
The  game  also  ends  when  one  player  has  captured  more  than 
half  of  the  counters  (if  you  have  more  than  24  counters,  it's 
numerically  impossible  for  the  computer  to  win  the  game). 
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Wari  also  permits  a  stalemate,  where  you  and  the  computer 
chase  each  other  around  the  board  fruitlessly;  a  stalemate 
game  should  be  ended  at  your  discretion. 

At  the  end  of  the  game,  your  score  is  increased  by  the 
number  of  counters  remaining  on  your  side  of  the  board.  The 
computer  automatically  totals  the  score  and  announces  the 
winner.  You  may  end  the  game  at  any  time  by  pressing  the  Q 
key. 

Game  Limits 

As  mentioned  above,  at  the  beginning  of  each  game,  the  com- 
puter also  asks  whether  you  wish  to  play  a  limited  or  unlim- 
ited game.  A  limited  game  consists  of  a  set  number  of  moves 
for  each  player;  an  unlimited  game  lasts  until  the  game  ends 
in  one  of  the  ways  described  above.  Press  L  for  a  limited  game 
or  U  for  an  unlimited  game. 

Limits  of  25-35  moves  make  for  interesting  games.  In  a 
very  short  limited  game  (say,  5  moves)  it's  usually  more  im- 
portant to  protect  counters  on  your  side  of  the  board  than  to 
capture  the  computer  player's  counters;  when  the  game  ends, 
you  are  awarded  all  the  counters  on  your  side. 

Wari 

Filename:  WARI 

For  instructions  on  entering  this  program,  piease  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

*   Copyright  1987  COMPUTE!  Publications,  Inc.* 
Al 3  Rights  Reserved* 

4 

setup: 4 

CLEAR  ,250004 

CLEAR  ,655368c4 

SCREEN  1,320,200,3, 1: WINDOW  3, " " , (0, 0) - (31 1 , 186) , 16, 

14 

WINDOW  OUTPUT  34 

PALETTE  0,0, 0,0: PALETTE  1,-1,. 2,. 8    '  black,  blue4 

PALETTE  2,. 33,. 9,0: PALETTE  3,0,. 93,. 87    »  green,  aq 

ua4 

PALETTE  4,1,. 1,-27: PALETTE  5,. 8,0,. 93     »  red,  purp 

le4 

PALETTE  6, 1,1,. 13: PALETTE  7,1,1,1    »  yellow,  white4 

DIM  a(12),b<12),sc(80),i (80)4 

RANDOMIZE  TIMER: ds*=STRINB* (39, 32) 4 

DIM  waveform* (255) 4 
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wavedata=-12S4 

FOR  n=0  TO  255:  waveform?.  (n)»wavedata4 

wavedata=wavedata+l : NEXT4 

WAVE  0,waveform7.4 

4 

restart: 4 

CLS: LOCATE  1,10: COLOR  6,0: PRINT  STRING* (21 , 42) 4 

PRINT  TAB (10)"*";: COLOR  0,1:  PRINT  STRING* < 19, 32) ; 4 

COLOR  6,0: PRINT  "*"4 

PRINT  TAB (10)"*";: COLOR  0,1:PRINT  "     Amiga   Wari 

";4 
COLOR  6,0: PRINT"*"  4 

PRINT  TAB (10)"*";: COLOR  0,1:PRINT  STRING* ( 19, 32) ;  4 
COLOR  6,0: PRINT  "*"4 
PRINT  TAB (10) STRING* (21, 42) 4 

PRINT:COLOR  3:PRINT  TAB < 13) "Computer7 s  Side":cp«0:mc 
=0  4 

COLOR  5: PRINT  TAB (13) "Move  #";: COLOR  1: PRINT  mc4 
COLOR  5: PRINT  TAB (13) "Score: ";: COLOR  4: PRINT  cp4 
COLOR  2:PRINT:PRINT  "     <<F<<<<E<<<<D<<<<C<<<<B<<<< 
A<<<"4 
GOSUB  dash: PRINT  "     ";4 

FOR  i-1  TO  6: PRINT  CHR*<124)" ";: NEXT: PRINT  CHR* < 

124)4 

GOSUB  dash4 

COLOR  2:PRINT  "     >>G»>>H>>»I  »»J»>>K>»>L>>>"4 

PRINT: COLOR  7: PRINT  TAB ( 13) "Player » s  Side":pl=0:mp«0 

4 

COLOR  5: PRINT  TAB < 13) "Move  #";: COLOR  1: PRINT  mp4 

COLOR  5: PRINT  TAB( 13) "Score: ";: COLOR  4: PRINT  pi 4 

FOR  t-1  TO  12:a<t)«4:b<t)«4:G0SUB  placepieces:NEXT  t 

4 

4 

gametype:4 

LOCATE  23,1: COLOR  0, 6:PRINT"L" ; : COLOR  6,04 

PRINT  "i mi  ted  or  ";:COLOR  0,6: PRINT  "U";4 

COLOR  6,0: PRINT  "nlimited  game?  ";4 

4 

type: 4 

GOSUB  getchar:IF  b*<>"L"  AND  b*<>"U"  THEN  type4 

PRINT  b*:FOR  tm=l  TO  400: NEXT: ml =04 

IF  b*="U"  THEN  COLOR  0,1: LOCATE  4, 16: PRINT  "Unlimite 

d":GOTO  first 4 

4 

moves: 4 

GOSUB  cline: PRINT  "Move  Limit"; : INPUT  ml 4 

ml=INT<ml): IF  ml<=0  THEN  moves4 

LOCATE  4,15:C0L0R  0,1:PRINT  "Limited: "+STR* (ml ) 4 

4 

first:4 

LOCATE  23,1: COLOR  3,0: PRINT  "Who  goes  first:  ";:4 
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COLOR  0,3: PRINT  "C";: COLOR  3,0: PRINT  "omputer  or  ";4 

COLOR  0,3: PRINT  "P";: COLOR  3,0: PRINT  "layer?  " ; 4 

4 

getf irst:4 

GOSUB  getchar:IF  b*<>"C"  AND  b*<>"P"  THEN  getfirst4 

PRINT  b*:FOR  tm=l  TO  400: NEXT  tm4 

IF  b*="C"  THEN  computer4 

4 

player: 4 

p$="P"  s  p=0:  sp=0:  mp=mp+14 

COLOR  1: LOCATE  20, 19: PRINT  mp4 

FOR  -f«7  TO  12:p=p+a(-f):NEXT  -f4 

entry: 4 

COLOR  7: LOCATE  23,1: PRINT  ds*: LOCATE  23,14 

PRINT  "Player's  turn.  Move  counters  (G-D?  " ;  4 

IF  p=0  THEN  nocounters4 

GOSUB  getchar:i=ASC(b*) -64: COLOR  3: PRINT  b»4 

IF  b*="Q"  THEN  quit4 

IF  b*>«"G"  AND  b»<*"L"  THEN  IF  a(i)<>0  THEN  okmove4 

COLOR  4:G0SUB  cline:PRINT  "Illegal  move!!!"4 

FOR  tm=l  TO  1500: NEXT: GOTO  entry4 

okmove:4 

ds«l: GOSUB  movecounters: FOR  tm=l  TO  900: NEXT  tm4 

pt=0:FOR  f  =  l  TO  12:a(f  )=b(f  ):pt-pt+a<f )  :  NEXT  f4 

IF  mp=ml  AND  mc=ml  THEN  award4 

IF  pt«0  THEN  nocounters4 

IF  pl>24  THEN  award4 

4 

computer : 4 

p*«"C"  :pa=0:pb=0:  ia-0:  ib=0:  p*0:  mc»mc+14 

COLOR  1: LOCATE  8, 19: PR I NT  mc4 

FOR  f-1  TO  6:p«p+a(f ):NEXT  f4 

COLOR  3: GOSUB  cline4 

PRINT  "Computer's  turn  (Move  counters  A-F) .  " ; 4 

IF  p=0  THEN  nocounters4 

4 

checkmoves:4 

FOR  g»l  TO  124 

sc (g)=0: i (g)«04 

IF  g=7  THEN  p»«"P"4 

IF  a(g)=0  THEN  skip4 

sc=0: sp=0: i  »g4 

ds=0: GOSUB  movecounters4 

sc(g)=sl  OR  s2:i(g)»t04 

skip: 4 

NEXT  g4 

p*«"C"4 

4 

pickbest: 4 

FOR  -f-1  TO  64 

IF  pa>«sc(f)  THEN  ahead4 
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ia«f :pa=5C <f  >4 

ahead: 4 

IF   pb>=sc<f+6>    OR   a<i<f+6>>=0   THEN   skip24 

ib-i <f+6>:pb»sc<f+6>4 

skip2:4 

NEXT  f4 

IF  ia-0  AND  ib=0  THEN  skip34 

i-ia:IF  pb>pa  THEN  i«ib4 

GOTO  printit4 

skip3:4 

p-0:FOR  f«7  TO  12:p»p+a<f > :NEXT  f4 

IF  p<>0  THEN  random4 

FOR  f-1  TO  54 

IF  a(f)<>0  AND  a(f)<»6-f  THEN  i«f:GOTO  print! t4 

NEXT  f4 

random: 4 

i«INT(RND*6)+l:IF  a(i)-0  THEN  random4 

4 

printit:4 

COLOR  7:PRINT  CHR* <i+64> : sc-04 

ds*ls GOSUB  movecounters:FOR  tm*l  TO  1500: NEXT  tm4 

pt«0:FOR  f«l  TO  12: a (f )«b(f >:pt=pt+a(f ):NEXT  f4 

IF  mp»ml  AND  mc»ml  THEN  awards 

IF  pt«0  THEN  nocounters4 

IF  cp>24  THEN  award* 

GOTO  pi aver 4 

4 

nocounters:4 

FOR  tm-1  TO  600:NEXT4 

COLOR  4:G0SUB  cline:PRINT  "No  counters!!!  ";4 

gameends4 

IF  pt-0  THEN  PRINT  "Game  over. "4 

FOR  tm«l  TO  1500:NEXT4 

IF  pt*0  THEN  winner4 

4 

award: 4 

COLOR  4:G0SUB  cline: PRINT  "Game  over.  ";4 

COLOR  6: PRINT  "Award  counters. "4 

FOR  f-1  TO  64 

pS»"C":sc-a(f ):t»f :b(t)«0:GOSUB  placepieces  4 

p*«"P" : sp«a (f +6) : t*f +6: b ( t ) -0: GOSUB  pi acepieces4 

NEXT4 

4 

winner: 4 

GOSUB  cline4 

COLOR  3: IF  pl=cp  THEN  PRINT  "A  draw.  " ; : GOTO  another 

4 

IF  pl>cp  THEN  COLOR  2: PR I NT  "Player  wins.  ";:GOTO  an 

other4 

COLOR  4: PRINT  "Computer  wins.  ";4 

4 
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another: 4 

COLOR  7: PRINT  "Another  game  (Y/N)?  ";4 

another2:4 

BOSUB  getchar:IF  b*<>"Y"  AND  b*<>"N"  THEN  another24 

PRINT  b*: IF  b*~"Y"  THEN  restarts 

WINDOW  CLOSE  34 

SCREEN  CLOSE  14 

WINDOW  l,"Wari",,31,-14 

CLEAR  ,250004 

END   4 

4 

quit: 4 

FOR  tm=l  TO  200:NEXT4 

COLOR  4: BOSUB  cline4 

PRINT  "Quit  game.  Are  you  sure  (Y/N)?  ";4 

again: 4 

BOSUB  getchar:IF  b*<>"Y"  AND  b*<>"N"  THEN  again4 

IF  b*<>"Y"  THEN  entry4 

BOSUB  cl ine:pt«0:BOTO  gameend4 

4 

placepieces:4 

COLOR  74 

IF  t<7  THEN  tb=36-5*t:60T0  place4 

IF  t>6  THEN  tb=5*<t-6>+14 

place:4 

LOCATE  13-2*<t>6),tb:PRINT  b(t)4 

FOR  tm=l  TO  1000: NEXT  tm4 

IF  b(t)<>0  THEN  RETURN4 

IF  p*«"P"  THEN  BOSUB  pi ayer score: RETURN4 

IF  p*«"C"  THEN  BOSUB  computerscore: RETURN4 

4 

movecounters: 4 

t=i:sl=0:s2»04 

FOR  f«l  TO  12:b(f)=a(f ):NEXT4 

b(t)-0:IF  ds  THEN  BOSUB  placepieces4 

FOR  f=l  TO  a(t)4 

t=t+14 

IF  t>12  THEN  t-14 

b(t)-b(t)+l:IF  ds  THEN  BOSUB  placepieces4 

NEXT  f:t0=t4 

4 

captures: 4 

IF  b(t0)<2  OR  b(t0)>3  THEN  RETURN4 

IF  p*»"P"  AND  t0O6  THEN  total4 

IF  p*="C"  AND  t0>-7  THEN  total4 

RETURN4 

4 

total: 4 

ls=l:IF  p*«"C"  THEN  ls-74 

FOR  f-t0  TO  Is  STEP  -14 

IF  b(f)<2  OR  b(f)>3  THEN  RETURN4 
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IF  p*«"PM  THEN  sp*b(f >:s2»s2+sp:G0T0  total24 

IF  p*="C"  THEN  sc=b(f >:sl»sl+sc4 

total2:4 

b(f)=0:IF  ds  THEN  t=f:GOSUB  placepieces4 

NEXT  f:RETURN4 

4 

getchar:4 

b**UCASE*<INKEY*):IF  b*<>,,M  THEN  getchar4 

getchar2:4 

b*«UCASE*(INKEY$):IF  b*=""  THEN  getchar2  ELSE  RETURN 

4 

4 

pi ayer score: 4 

IF  sp=0  THEN  RETURN4 

FOR  h=pl+l  TO  pl+sp4 

COLOR  4: LOCATE  21, 19: PRINT  h4 

SOUND  440, 2, 255,0: FOR  tm«l  TO  500:NEXT4 

NEXT  h:pl=pl+sp:RETURN4 

4 

computer score: 4 

IF  sc-0  THEN  RETURN4 

FOR  h»cp+l  TO  cp+sc4 

COLOR  4: LOCATE  9, 19: PR I NT  h4 

SOUND  220, 2, 255,0: FOR  tm=l  TO  500:NEXT4 

NEXT  h:cp=cp+sc:RETURN4 

4 

dash: 4 

COLOR  l:FOR  j*l  TO  2: FOR  i=l  TO  7: PRINT  "     "CHR$(1 

24);  4 

NEXT: PRINT: NEXT: RETURN4 

4 

cl ine:4 

LOCATE  23,1: PRINT  ds*: LOCATE  23, 1 : RETURN4 
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Euchre 

David  Shimoda 
Translation  by  Tim  Midkiff 


Here's  a  finely  detailed  implementation  of  the  classic 
card  game  of  Euchre.  The  Amiga's  stunning  graphics 
powers  are  combined  with  its  speed  and  precision  to 
create  a  visuaiiy  exciting  and  chaiienging  game.  The 
Amiga  aiso  provides  a  partner  and  two  opponents  in 
this  keyboard-controlled,  one-piayer  version. 


"Euchre"  is  a  four-handed  translation  of  the  popular  card 
game  of  the  same  name.  In  this  version,  you  play  with  a  com- 
puter partner  against  two  computer  opponents.  The  computer 
will  deal  the  cards,  keep  score,  and  play  your  partner's  as  well 
as  your  opponents'  hands.  Even  better,  it  never  gets  bored  or 
commits  blunders  such  as  trumping  your  ace.  Nearly  all  the 
subtleties  of  the  original  card  game  are  reproduced  faithfully, 
including  lone  hands,  short  suits,  and  more.  You  can  even 
choose  different  personalities  for  your  partner  and  opponents. 
Type  in  the  program  and  save  a  copy  before  you  run  it. 

Computer  Personalities 

The  game  begins  by  asking  you  to  choose  personalities  for 
your  partner  and  your  opponents.  Move  the  reverse-video 
cursor  to  your  choices,  and  make  selections  by  pressing  the 
Return  key. 

The  normal  personality  plays  a  more  cautious  game, 
while  the  aggressive  personality  tends  to  take  more  risks.  Both 
opponents  must  have  the  same  personality,  but  the  partner's 
personality  is  chosen  separately.  This  makes  the  game  much 
more  varied  than  if  the  computer  players  always  stick  to  the 
same,  predictable  strategy.  One  of  the  more  difficult  combina- 
tions is  to  choose  a  normal  partner  and  aggressive  opponents. 
Of  course,  your  own  style  of  play  will  have  an  impact  on 
which  combination  you  prefer. 
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Dealing  and  Trump 

This  Euchre  variation  uses  only  24  cards  from  the  standard  52- 
card  deck.  Each  suit  includes  only  the  9,  10,  jack,  queen,  king, 
and  ace  (the  ace  is  high).  Before  actual  play  begins,  the  first 
dealer  must  be  selected.  This  is  done  by  dealing  out  cards  un- 
til a  black  jack  is  thrown.  The  first  person  who  receives  a 
black  jack  becomes  the  first  dealer.  Press  the  Return  key  for 
the  dealing  to  begin.  After  each  hand,  the  position  of  dealer 
passes  to  the  next  player  in  clockwise  order. 

The  dealer  distributes  5  cards  to  each  player  and  then 
places  1  card,  face  up,  on  the  center  of  the  table.  As  a  conse- 
quence of  this  scheme,  only  21  of  the  24  cards  are  in  play  for 
any  given  hand.  (Three  cards  are  always  left  unplayed.) 

The  next  step  is  to  choose  trump;  the  trump  suit  is  the 
most  powerful  of  the  four  suits  for  the  current  hand.  Trump  is 
determined  by  moving  around  the  table  in  clockwise  order, 
giving  each  player  an  opportunity  to  choose  whether  the 
dealer  should  pick  up  the  center  card.  Each  player  can  either 
pass  or  order  up — order  the  dealer  to  pick  up  the  center  card. 
When  the  dealer  is  forced  to  take  the  center  card,  that  card's 
suit  becomes  trump,  and  the  dealer  discards  one  card.  The 
computer  players,  of  course,  decide  for  themselves  whether  to 
pass  or  to  order  up  in  this  phase  of  the  game. 

If  no  player  chooses  to  order  up  in  the  first  circuit  of  the 
table,  each  player  then  has  a  chance  to  pick  any  other  suit  as 
trump.  If  no  player  chooses  trump  on  the  second  circuit,  the 
hand  is  thrown  out  completely,  and  another  is  dealt. 

Lone  Hands 

On  certain  occasions,  a  player  may  choose  to  exclude  his  part- 
ner from  play,  a  tactic  which  is  known  as  playing  lonehand. 
The  player  who  chooses  trump  must  choose  at  the  same  time 
whether  or  not  to  play  lonehand.  If  a  player  orders  up  a  card 
into  his  partner's  hand,  the  player  who  ordered  up  must  play 
lonehand.  (If  your  partner  is  the  dealer  and  you  order  up,  you 
must  play  lonehand.) 

For  instance,  you  might  want  to  play  lonehand  in  a  case 
where  you  hold  most  of  the  high  cards  in  a  suit,  your  partner 
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is  the  dealer,  and  the  center  card  is  a  high  card  of  your  strong 
suit.  By  excluding  your  partner  and  playing  lonehand,  you  are 
in  a  very  strong  position  to  take  most  or  all  of  the  tricks. 

Tricks  and  Hands 

A  hand  consists  of  five  tricks.  A  trick  consists  of  all  players 
laying  down  one  card.  The  player  to  the  left  of  the  dealer 
throws  down  the  first  card  in  the  first  trick.  Subsequent  tricks 
are  begun  by  the  winner  of  the  previous  trick.  Suit  must  be 
followed  within  a  trick.  That  is,  you  must  throw  a  card  of  the 
suit  which  was  led,  as  long  as  you  have  any  card  of  that  suit. 
To  play  a  card,  use  the  right  and  left  cursor  keys  to  move  the 
special  hand  icon  over  the  one  you  wish  to  throw.  When  it's 
in  place,  press  the  Return  key  to  play  the  card. 

If  no  trump  cards  are  thrown  in  a  trick,  the  trick  is  won 
by  the  player  who  laid  the  highest  card  of  the  leading  suit.  If 
trump  is  thrown,  then  the  highest  trump  card  takes  the  trick. 

For  all  suits  except  the  trump  suit,  the  rank  of  the  cards 
follows  the  usual  order.  (The  9  is  low,  and  the  ace  is  high.) 
For  the  trump  suit,  however,  the  jack  is  the  highest-ranking 
card.  The  jack  of  the  same  color,  but  different  suit,  is  consid- 
ered part  of  the  trump  suit — and  it  is  the  second  highest  rank- 
ing card.  For  example,  if  the  trump  suit  is  chosen  as  clubs,  it 
follows  this  ranking: 

jack  of  clubs 
jack  of  spades 
ace  of  clubs 
king  of  clubs 
queen  of  clubs 
10  of  clubs 
9  of  clubs 

A  hand  is  won  by  the  side  which  wins  a  majority  of  tricks 
(three  or  more).  If  you  or  your  partner  orders  up  a  card,  your 
side  must  take  the  majority  of  tricks  in  that  hand  or  else  be 
euchred,  meaning  that  the  opposite  side  gets  two  extra  points. 
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Scoring 

A  game  of  Euchre  ends  when  one  side  accumulates  ten  or 
more  points.  You  score  one  point  for  winning  a  hand,  two 
points  for  winning  all  the  tricks  in  a  hand,  and  four  points  for 
winning  all  the  tricks  lonehand. 

Euchre 

Filename:  EUCHRE 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

'   Copyright  1987  COMPUTE!  Publication*,  Inc.* 

All  Rights  Reserved 4 
4 

Euchre: 4 

DEFINT  a-z:DEFSNG  r , g, b,cy: RANDOMIZE  TIMER4 
SCREEN  1,320,200,4,1: WINDOW  3, " " , (0,0) - (31 1 , 186) , 16, 
1: WINDOW  OUTPUT  3: COLOR  3,04 
RESTORE  PaLetteData:FOR  i*0  TO  15: READ  r , g, b: PALETTE 

i,r,g,b:NEXT4 
PaLetteData:  4 

DATA  .2, .2, .9,0,0,0,0,0,0, .8,0,04 
DATA  .  8,  .  8,  .  8,  0,  0,  1 ,  1 ,  1 ,  0,  .  93,  .  93,  04 
DATA  .87, .87, 0,0,. 8, 0,0, 1,0,1, 1,04 

DAT  ft   .  O  ,  .  O  ,  aw,  .  5,  ■  w  ,  .  «Ja  .  O,  ■  O,  ■  Oa  ■',  ■',  .74 

GOSUB  InitiaLize:QOSUB  DispLay: GOSUB  PLayers: GOSUB  P 

ickDeaLer4 

NewHand: 4 

GOSUB  Bidding4 

IF  tp»4  THEN4 

COLOR  0,4: LOCATE  12, 29: PRINT  "NO  BIDDERS"4 

LOCATE  13, 28: PRINT  "HAND   DUMPED "4 

GOSUB  WaitKey:x»20:FOR  i=0  TO  4:y»it5+2: GOSUB  EraseC 

ard:NEXT  4 

dL=FNnp(dL) :x«8:y= 12: GOSUB  EraseCard4 

COLOR  ,0: GOSUB  CLRMess:GOTO  NewHand4 

END  IF: COLOR  5, 4: LOCATE  12, 29: PRINT  "TRUMP  :  "4 

LOCATE  13, 29: PRINT  "BIDDER:  ";4 

IF  bd=0  THEN  4 

PRINT  "you" ; 4 

ELSE4 

PRINT  "p"; RIGHT* <STR*<bd>, 1)4 

END  IF: PUT (288, 88) , sb (0, tp ) , PSET4 

IF  ku<>0  THEN  4 

IF  dL<=0  THEN  4 

COLOR  11, 2: LOCATE  15, 28: PRINT  "PICK  DISCARD"4 

GOSUB  UPickCard: COLOR  ,4: LOCATE  15, 28: PRINT  " 

";4 
ELSE4 
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GOSUB  UDiscard4 

END  IF:c(dL,f)=kc:s(dL,f)-ks: GOSUB  PutHand4 

END  IF: x-8:y-12: BOSUB  Eras«€ard4 

GOSUB  ResetHand: GOSUB  PLayHand: COLOR  0,44 

IF  NOT((pw(0)>9)  OR  (pw(l)>9))  THEN  4 

x»21:y=31:n-0: GOSUB  Pr intScore4 

x-21:y-37:n-0: GOSUB  PrintScor«4 

x-7:y-31:n-pw<0) : GOSUB  PrintScore4 

x-7: y-37: n-pw ( 1 ) : GOSUB  Pr i  ntScore4 

dL-FNnp(dL): GOSUB  ExitLoopPD:GOTO  NewHand4 

END  IF:wt-0:IF  pw(l)>-10  THEN  wt-14 

x-7: y-28+wt*6: n-1 : GOSUB  Pr i  ntScor©4 

x-7: y=31+wt*6: n»pw (wt ) -10: GOSUB  Pr intScor©4 

FOR  d«-l  TO  2000:NEXT4 

GOSUB  CLearWindow: COLOR  11, 3: LOCATE  13, 28: PRINT  "   Y 

0U";4 

IF  wt=0  THEN  PRINT  "  WIN!   "4 

IF  wt-1  THEN  PRINT  "  LOSE   "4 

COLOR  4,0: LOCATE  2, 2: PRINT  "Play  again?"4 

Lo-1 1 : hi -12: xp-2: yp-14: GOSUB  SeLecti on4 

SCREEN  CLOSE  1: WINDOW  CLOSE  34 

IF  an- 11  THEN  RUN  4 

END4 

4 

DispLay:  4 

GOSUB  InitShapes: WIDTH  40: CLS: COLOR  ,04 

LINE (0,0) -(3, 3), 2, bf : GET (0, 0) -(3, 3) ,en4 

LINE(0,0)-(3,3),ll,bf :GET(0,0)-(3,3),nb4 

GET (4, 4) -(40, 44), ec: LINE (4, 4) -(40, 44), 4, bf 4 

GET (4, 4) -(40, 44) , cb: GET (4, 4) - ( 17, 21 ) ,eh:CLS4 

FOR  i-0  TO  3: j=i *2:LINE (216+j , j ) - (31 1-j , 23-j ) „ i+12,b 

f :NEXT4 

COLOR  2, 4: FOR  i-0  TO  6  STEP  2: LINE (224, 7+i ) - (303, 7+i 

):NEXT4 

LOCATE  2,31:PRINT  "EUCHRE" : LINE (224, 15) - (303, 15) 4 

COLOR  10, 2: LOCATE  4, 28: PRINT  "    POINTS    4 

LOCATE  18, 28: PRINT  "    TRICKS    "4 

COLOR  9, 2: LOCATE  5, 28: PRINT  "  YOU    COMP  "4 

LOCATE  19, 28: PRINT  "  YOU    COMP  "4 

FOR  i-0  TO  4: LOCATE  6+i, 28: PRINT  w*: LOCATE  20+i,28:P 

RINT  w«; :NEXT  4 

LINE (216, 40) -(31 1,40), 9: LINE (216, 152) -(31 1,152), 94 

LINE (262, 32) - (262, 79) ,9: LINE (262, 144) - (262, 191 ) , 94 

COLOR  ,4:  LOCATE  11,  28:  PRINT  v**:  LOCATE  17,  28:  PRINT  w* 

: GOSUB  CLearWindow4 

FOR  i-0  TO  3:LINE(216,80+i)-(311,80+i),i+124 

LINE (216, 132+i ) - (31 1 , 132+i ) , 15-i : NEXT  4 

n-0:x»7:y-31: GOSUB  PrintScore:y=37: GOSUB  PrintScore4 

x-21:y=31:G0SUB  PrintScore:y=37: GOSUB  PrintScore4 

COLOR  4,0:RETURN4 

4 
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Ini tiaLize: 4 

DIM   c(3,4),s(3,4),ms(6,3),cL(7,3),dc(23),ds(23),sp(3 

,5),ns(3,5),me*(15)4 

DIM   en ( 19) , nb ( 19) , eh (75) , hb (75) , ec (507) , cb (507) , sb (3 

0,3)4 

DEF    FNnp<x)=(<x+l)/4-INT((x+l)/4))*44 

bL*«SPACE*<10):w*»SPACE*(12):c*="9    10J    Q   K   A   J    J      91 

0   J    Q    K    A   J    J"4 

FOR  i=0  TO  3: READ  co (i ): NEXT: DATA  3,2,3,24 

FOR  i»0  TO  6:READ  nf (i ): NEXT: DATA  4,0,1,2,3,4,04 

FOR  j=0  TO  3: FOR  i=0  TO  5: dc ( j*6+i )=i :ds ( j*6+i ) =j : NE 

XT  i,j4 

FOR  i=0  TO  3: READ  px (i ), py (i ): NEXT: DATA  14,12,8,7,2, 

12,8, 174 

FOR  i=0  TO  3:READ  ex (i ) , cy (i ) :NEXT: DATA  18,11,11,4,4 

,11,11,184 

FOR  i=0  TO  5: READ  cp (i ): NEXT: DATA  1,1,8,1,2,-14 

FOR  i-0  TO  13: READ  me* (i ) : NEXT4 

DATA  "pass     ","order  up", "pass    M,Hpick  up","   PA 

SS   ", "diamonds" 4 

DATA  "clubs    ", "hearts   ", "spades   ", "normal     "," 

aggressive", "yes", "no  " , "yes"4 

FOR  i=0  TO  3:READ  mx (i ), my (i ): NEXT: DATA  1,1,8,3,2,11 

,8,194 

FOR  i=0  TO  6: READ  ob (i ) , ou (i ) , PU (i ) , ms (i , 0) , ms (i , 1 ) , 

ms(i,2) ,ms(i,3),ga(i) :NEXT4 

DATA  99,99,99,99,99,99,99,994 

DATA  99,99,99,99,99,99,99,994 

DATA  99,99,14,14,14,13,13,994 

DATA  20,12,8,8,8,8,7,194 

DATA  14,0,0,0,0,0,0,164 

DATA  0,0,0,0,0,0,0,144 

DATA  0,0,0,0,0,0,0,04 

FOR  i=0  TO  9: READ  pt& (i ) : NEXT4 

DATA  167684798c,  13421772&,  16719823&,  16764879&,  1343433 

3&4 

DATA  16764703&, 16768799&, 13421791&, 16768991&, 1342255 

9&  4 

RETURN4 

4 

PutCard:  4 

IF  (s=tp)  AND  (c=6)  THEN  s=s+2:  s=  (s/4-INT  (s/4)  )  *44 

NC=c*2+l: COLOR  co(s) , 4: px= (y-1 ) *8-2: py= (x-1 ) *8-14 

PUT(px,py) ,cb,PSET: : px=px+l : py=py+2: PUT (px , py+8) , sb ( 

0,s) ,PSET4 

px=px+2: py=py-l : PUT (px+22, py+21 ) , sb (0, s) , PSET4 

LOCATE  x,y: PRINT  MID* (c*, NC, 2) : LOCATE  x+4, y+2: PRINT 

MID*(c*,NC+16,2)  ;4 

RETURN  4 

4 

PutHand:  FOR  u=0  TO  4: x«20: y«u*5+24 
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c-c (0, u) : s=s (0, u) : GOSUB  PutCard: NEXT: RETURNS 

4 
DeaLCards:  FOR  i«0  TO  23: j=INT (RND( 1 ) *24) : t«dc (i ) : dc 
(i)»dc(j):dc(j)-t4 

t»ds(i):ds(i)=ds(j):ds(j)=t:NEXT:FOR  j-0  TO  3:F0R  i= 
0  TO  44 

c  ( j ,  i  ) «dc ( j  *5+i ) : s ( j , i ) »ds ( j  *5+i ) : NEXT  i  ,  j : kc=dc  <  20) 
: ks=ds  <  20) : RETURN* 
4 

PickDeaLer:  4 

COLOR  0,4: LOCATE  13, 28: PRINT  "FIRST   BLACK": LOCATE  1 
4, 29: PRINT  "JACK  DEALS"4 
GOSUB  DeaLCards: dL»0:cc«04 

LoopPD:  c=dc(cc) :s«*ds(cc) :x«cx (dL) :y»cy (dL) :BOSUB  Pu 
tCard4 

FOR  de«l  TO  500: NEXT  4 

IF  (dc(cc)»2)  AND  ((ds(cc)  AND  253)=1)  THEN  ExitLoop 
PD4 

x»cx (dL) : y-cy (dL) : GOSUB  EraseCard4 
FOR  de«l  TO  100: NEXT  4 
cc«cc+l:dL»FNnp(dL):GOTO  LoopPD4 

Ex it LoopPD:  GOSUB  CLear Window: COLOR  0,4: LOCATE  12,29 
4 

IF  dL<>0  THEN  4 
PRINT  "  PLAYER ";STR*(dD  4 
LOCATE  13, 30: PRINT  "  DEALS"; 4 
ELSE4 

PRINT  "YOUR   DEAL"; 4 
END  IF: GOSUB  WaitKey4 

x-cx (dL): y-cy (dL): GOSUB  EraseCard: COLOR  7,1:RETURN4 
4 

Wait Key:  COLOR  3, 2: LOCATE  15, 28: PRINT  "  HIT  RETURN  " 
: SOUND  2000,64 

WHILE  INKEY*OCHR*(  13):  WEND:  GOSUB  CLearWindow: COLOR 
7,1:RETURN4 
4 

CLearWindow:  COLOR  ,4: FOR  i«12  TO  16: LOCATE  i, 28: PR I 
NT  w*:NEXT:RETURN4 
4 

PrintScore:4 

tx-(y-l)»8:py»(x-l)*8:bt««-l:i«c=pt&(n)4 
FOR  q-0  TO  5: FOR  p=0  TO  3: px»tx+p»44 

IF  (bt«c  AND  i«c)<>0  THEN  PUT(px ,  py)  ,nb,  PSET  ELSE  PUT  ( 
px , py ) , en , PSET4 

px«tx+p»4:  bt8c-btS<»2:  NEXT  p:  py«py+4:  NEXT:  RETURN4 
4 

SetPoints:  4 

FOR  i-0  TO  3:sp(p,i)«fc(p  AND  253) : n* (p, i ) »0:NEXT  4 
FOR  i=0  TO  4:s=s(p, i ) :c=c(p, i) :sp (p,s)=sp (p,s)+cp (c) 
ins  (p,s)aens  (p, s) +14 
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IF   c«2   THEN    s«s+2:s=(s/4-INT(s/4))*4:sp(p,s)»sp(p,s) 

+6:ns (p, s)=ns (p, s)+14 

IF    c=5   THEN    4 

FOR    j=0    TO    3:sp(p, j)»sp(p, j) +4: NEXT    4 

END    IF:NEXT:ss=0:FOR    i»0   TO   4: IF   ns(p,i)=0   THEN   sp(p 

, i )=0:ss=ss+14 

NEXT:FOR    i«0   TO   3: sp (p, i ) -sp (p, i ) +ss:NEXT   4 

IF    p»dL    THEN   4 

IF    kc*5   THEN   sp (p, ks) =sp (p, ks) +44 

sp (p, ks)=sp (p, ks)+cp (kc) : ns (p, ks) =ns (p, ks)+14 

END    IF: RETURN   4 

4 

UOrderUp:  Lo«=0:  hi  »1 :  xp=14:  yp«10:  GOSUB  SeLection4 

IF  an=l  THEN  tp=ks4 

RETURN  4 

4 

ULoneHand:  LOCATE  14, 9: PRINT  "Lonehand" ; 4 

Lo=12: hi  =  13: xp=14: yp=18: GOSUB  SeLection : Lh=04 

IF  an=13  THEN  Lh=l: LOCATE  mx (bd) , my (bd) : PRINT  "Loneh 

and"; 4 

LOCATE  14, 9: PRINT  "  ";4 

RETURN  4 

4 

CGoALone:  Lh«0: IF  sp (p, tp) >ga (ns (p, tp) )  THEN  Lh=14 

RETURN4 

4 
COrderUp:  IF  FNnp (FNnp (p) )=dL  THEN  GOSUB  CGoALone:f= 
Lh:GOTO  ExitC0U4 
f«0:IF  kc<>2  THEN  4 

IF  sp(p,ks)>ou(ns(p,ks) )  THEN  f  =  14 
END  IF: IF  sp (p, ks) >ob (ns (p, ks) )  THEN  f  =  14 
IF  (f=0)  OR  (pOFNnp(dD)  THEN  ExitC0U4 
sb»cp(kc):IF  kc=5  THEN  sb=34 
FOR  i=0  TO  3:IF  iOks  THEN  IF  sp  (p,  i  )  >=  (sp  (p,  ks) -sb) 

THEN  f=04 
NEXT  4 

ExitCOU:  IF  f  =  l  THEN  tp=ks4 
RETURN  4 
4 

UPickUp:  Lo=2:hi»3:xp=14:yp=10: GOSUB  SeLection4 
IF  an=3  THEN  tp=ks4 
RETURN  4 
4 

CPickUp:  IF  sp (p, ks) >PU(ns(p, ks) )  THEN  tp=ks4 
RETURN  4 
4 

UMake:  Lo=4:hi=8:xp=14: yp=10: GOSUB  SeLection4 
IF  an-5=ks  THEN  UMake4 
IF  an>4  THEN  tp=an-54 
RETURN  4 
4 
CMake:  df=0:FOR  i=0  TO  34 
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IF  iOks  THEN* 

IF  sp (p, i )-ms(ns(p, i ) ,ps) >=df  THEN  df =sp (p, i ) -ms (ns( 

p, i ) ,ps) :tp=i4 

END  IF:NEXT4 

RETURNS 

4 

CLRMess:  FOR  i=l  TO  3: FOR  j=0  TO  2: LOCATE  mx(i)+j,my 

(i): PRINT  SPACE* (8); 4 

NEXT  j,i: RETURNS 

4 

SeLection:  4 

an=Lo: k*=" " : WHILE  k*<  >CHR* (13)4 

xl=xp:yl=yp:FOR  i=Lo  TO  hi:COLOR  4,04 

IF  i=an  THEN  4 

IF  (an=Lo)  OR  (hi-Lo=l)  THEN  COLOR  0,4  ELSE  COLOR  ,c 

o(i-Lo-l)4 

END  IF: LOCATE  xl,yl: PRINT  me* (i ) ; : x l=x 1+1 : NEXT4 

WaitS:  k*=INKEY*:  IF  k*=""  THEN  Waits  4 

IF  k*=CHR*<28)  THEN  4 

an=an-l:IF  an<Lo  THEN  an*hi4 

ELSE IF  k*=CHR*(29)  THEN  4 

an-an+^IF  an>hi  THEN  an=Lo4 

END  IF: WEND: xl«xp:yl»yp: COLOR  4,04 

FOR  i=Lo  TO  hi:LOCATE  xl,yl:PRINT  bL*; :x l«x 1+1 : NEXT4 

RETURN4 

4 

Bidding:  4 

GOSUB  DeaLCards:GOSUB  PutHand:p=FNnp (dL) : tp=4:bd*0:  k 

u=«04 

x=8:y=12:c=kc:s=ks: GOSUB  PutCard: COLOR  4,04 

IF  dL<>0  THEN  LOCATE  mx (dL) , my CdL) : PRINT  "dealer "4 

5  GOSUB  SetPoints4 

IF  p*0  THEN  GOSUB  UOrderUp: GOTO  204 

IF  ABS<p-dL)<>2  THEN  7  4 

GOSUB  CGoALone:IF  Lh»l  THEN  tp«ks:GOTO  104 

7  GOSUB  C0rderUp4 

10  LOCATE  mx (p), my (p): COLOR  4,04 

IF  tp-4  THEN  PRINT  "  pass": GOTO  204 

bd-p: PRINT  "order  up"4 

20  p=»FNnp(p):IF  (pOdL)  AND  (tp-4)  THEN  54 

p«dL:GOSUB  SetPoints:IF  tp<>4  THEN  454 

IF  dL-0  THEN  GOSUB  UPickUp:GOTO  304 

GOSUB  CPickUp: LOCATE  mx (dL) ,my (dL)4 

IF  tp=4  THEN  PRINT  "turned" : LOCATE  mx (dL) +l,my (dL) :P 

RINT  "  down": GOTO  304 

bd=p:PRINT  "pi eked": LOCATE  mx (dL) +l,my (dL) :PRINT  " 

up  "4 

30  FOR  de-1  TO  2000:NEXT4 

IF  (bd»0)  AND  (tp<>4)  THEN  45  4 

x-B:y«12: GOSUB  EraseCard: IF  tp<>4  THEN  454 

GOSUB  CLRMess: ps-04 
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35   p«FNnp<p)4 

IF  p-0  THEN  60SUB  UMake:GOTO  404 

GOSUB  CMake: LOCATE  mx<p),my<p)4 

FOR  de=l  TO  600: NEXT* 

IF  tp-4  THEN  PRINT  "   pass";: GOTO  404 

bd«p: PRINT  me*(tp+5);4 

40  IF  (pOdL)  AND  (tp«4)  THEN  ps=»ps+l :  GOTO  354 

GOTO  504 

45  ku«l:IF  (bd=0)  AND  <dL=2)  THEN  Lh«l:GOTO  604 

50  IF  tp-4  THEN  704 

IF  <Lh«l)  AND  (bd<>0)  THEN  604 

IF  bd=0  THEN  GOSUB  ULoneHand: GOTO  704 

GOSUB  CGoALone4 

IF  Lh»0  THEN  704 

60  LOCATE  1,1:PRINT  "Lonehand'^ 

70  FOR  de«l  TO  2000:NEXT4 

GOSUB  CLRMess:RETURN4 

4 

UPickCard:  4 

f  «0: WHILE  c (0, f ) — 1 : f «f +1 : WEND: g=f 4 

PrintHand:  x  = (g*5+2) *8+l:PUT (x, 167) ,eh,PSET:x» (f *5+2 

) *8+l : PUT (x , 167) , hb, PSET4 

GetKeyUPC:  k$=INKEY*: IF  k*«=,,H  THEN  GetKeyUPC  ELSE  IF 

k*«CHR*(13)  THEN  ExitUPC4 
g«f : I F  k*<  >CHR* (31)  THEN  1 004 
90  f«nf (f):IF  c(0,f)<0  THEN  904 
GOTO  PrintHand4 

100  IF  k*OCHR*<30)  THEN  GetKeyUPC4 
110  f«nf <f+2):IF  c(0,f)<0  THEN  1104 
GOTO  PrintHand4 
GOTO  GetKeyUPC4 
Ex it UPC:  RETURN4 
4 

UDiscard:4 
FOR  i=0  TO  44 

IF  (s(p,i)=tp)  AND  (c(p,i)«2)  THEN  4 
c(p,i)=74 
ELSE  4 

IF  <<s<p,i)  AND  253)»(tp  AND  253))  AND  (c (p, i ) =2) THE 
N  c (p, i )=6: s (p, i )=tp4 
END  IF: NEXT  4 

FOR  i«0  TO  4: FOR  j»0  TO  34 
IF  NOT(s(p, j)>s(p, j  +  1))  THEN4 

IF  s<p, j)«s(p, j+1)  THEN  IF  NOT (c (p, j) >c (p, j+1 ) )  THEN 
4 

t=c(p, j) :c(p, j)=c(p, j+1) :c(p, j+l)«t4 
t»s(p, j):s(p,j)=s(p,j+l):s(p, j+l)=t4 


END  IF4 

END  IF:NEXT  j,i4 

FOR  i=0  TO  4:pt(i)=04 

IF  s(p,i)-tp  THEN  4 
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pt<i)«c<p,i)+104 

ELSE4 

IF  c(p,i)=5  THEN4 

pt<i)=94 

ELSE4 

IF  (B(p,i)Os(p,nf(i)))  AND  (s  (p,  i  )  <>s  (p,  nf  (i+2)  )  )  T 

HEN  pt(i)=-14 

END  IF4 

END  IF: NEXT  4 

L=99:F0R  1=0  TO  4:  IF  ptdXL  THEN  f=i:L*pt(i)4 

NEXT: RETURN  4 

4 

ResetHand:4 

FOR  i=0  TO  3: FOR  j=0  TO  3: ns (i , j) =0: NEXT: FOR  j=0  TO 

44 

IF  c(i,j)-2  THEN  4 

IF  s(i,j)=tp  THEN4 

c(i, j)«74 

ELSE4 

IF  ABS(s(i, j)-tp>=2  THEN  c  <i  ,  j  )  =6:  s  (i  ,  j  )  =tp4 

END  IF4 

END  IF:ns(i,s(i, j) )-ns(i , s(i , j) )+l:NEXT  j,i4 

RETURN  4 

4 

PLayers:4 

LOCATE  2, 2: PRINT  "Partner?"; : Lo=9: hi=10: xp=2: yp=12: G 

OSUB  SeLection4 

fc(0)=0:IF  an=10  THEN  fc<0)=24 

LOCATE  2, 2: PRINT  "Opponents?" ;: Lo=9: hi =10: xp=2: yp=14 

:GOSUB  SeLection4 

fc(l)-0:IF  an«10  THEN  fc(l)»24 

LOCATE  2, 2: PRINT  "  ";:RETURN4 

4 

PLayHand:  4 

FOR  i=0  TO  7:F0R  j=0  TO  3: cL (i , j ) =0: NEXT  j,i:cL(2,tp 

AND  253)=*14 
FOR  i=0  TO  3:sL(i )=0:NEXT  4 

Ld=FNnp(dL) :dm=4:tr (0)=0:tr (1)=0: IF  Lh<>0  THEN4 
IF  bd=2  THEN  x=20:FOR  i=0  TO  4: y=i *5+2:G0SUB  EraseCa 
rd:NEXT  4 

dm=FNnp(FNnp(bd) )4 

IF  Lh=l  THEN  IF  Ld=dm  THEN  Ld=FNnp(Ld)4 
END  IF: FOR  tk=0  TO  4: p=Ld: ps=0: tL=0: IF  dm=p  THEN  p=F 
Nnp(p)4 

GOSUB  PLayCard:wp=p: IF  Lh=l  THEN  ps»ps+14 
sL(s<p,pc<p) ) >=14 
IF  s<p,pc(p) )=tp  THEN  tL»l4 
FOR  i=l  TO  3:p=FNnp<p> : IF  p«dm  THEN  1304 
ps=ps+l:GOSUB  PLayCard: IF  tL=0  THEN  1204 


63 


CHAPTER  TWO 


IF  s(p,pc(p))=tp  THEN  IF  c  (p,pc  (p)  )  >c  (wp,  pc  (wp)  )  THE 

N  wp=p4 

GOTO  1304 

120  IF  s(p,pc(p))=tp  THEN  wp=p: tL»l : GOTO  1304 

IF  s(p,pc (p) )=s(wp,pc (wp) )  THEN  IF  c (p, pc (p) ) >c (wp, p 

c(wp) )  THEN  wp=p4 

130  NEXT: FOR  de=l  TO  400:NEXT4 

x=px (wp) : y^py (wp) :GOSUB  Winner4 

FOR  de=l  TO  3000: NEXT: Ld=wp:wt=wp  AND  253: tr (wt ) =tr ( 

wt)+14 

COLOR  2,3:x»21:y=31+6*wt:n=tr (wt):GOSUB  PrintScore4 

FOR  i=0  TO  3:x=px (i ) :y=py (i ) :GOSUB  EraseCard: c (i , pc ( 

i))=-l:NEXT  i,tk4 

COLOR  ,0: LOCATE  1,1: PRINT  "         ";4 

bt«bd  AND  253: LOCATE  15,284 

COLOR  2, 3: IF  NOT (tr (bt ) <3)  THEN4 

IF  N0T(tr(bt)<5)  THEN  4 

pw (bt ) »pw (bt ) +2+Lh*24 

IF  bt«0  THEN  PRINT  "   YOU   WON   ": LOCATE  16, 28: PRINT 

"  ALL  TRICKS  " : GOTO  1404 
IF  bt»l  THEN  PRINT  "COMPUTER  WON": LOCATE  16, 28: PRINT 

"  ALL  TRICKS  " : GOTO  1404 
END  IF:pw(bt)«pw(bt)+14 

IF  tr(0)>2  THEN  PRINT  "YOU  WON  HAND";: GOTO  1404 
IF  tr(l)>2  THEN  PRINT  "   COMPUTER   ": LOCATE  16, 28: PR 
INT  "   WON  HAND   " : GOTO  1404 
END  IF:pw(l-bt)=«pw(l-bt)+24 

IF  tr(0)<3  THEN  PRINT  "YOU'VE   BEEN": LOCATE  16, 28: PR 
INT  "   EUCHRED!   " : GOTO  1404 

IF  tr(l)<3  THEN  PRINT  "   COMPUTER   ": LOCATE  16, 28: PR 
INT  "   EUCHRED!   "4 
140  FOR  de-1  TO  4000:NEXT4 
RETURN4 

4 
PLayCard:  4 
IF  p<«0  THEN  4 

COLOR  11, 2: LOCATE  15, 28: PRINT  "  YOUR   PLAY  ";:GOSUB 
UPickCard4 
150  Ls«s(Ld,pc(Ld))4 

IF  NOT((ps»0)  OR  (s(p,f)=Ls)  OR  (ns (p, Ls) -0) )  THEN4 
GOSUB  PrintHand:GOTO  1504 
x»20:y«f*5+2:GOSUB  EraseCard:GOTO  1604 
END  IF: COLOR  ,4: LOCATE  15, 28: PRINT  "  ";4 

x«20:y«-f*5-»-2:  GOSUB  EraseCard:  GOTO  1604 
END  IF: IF  tk>=5  THEN  4 
FOR  k«0  TO  4: IF  c(p,j)>-l  THEN  f«i4 
NEXT: GOTO  1604 

END  IF: ON  (ps+1)  GOSUB  4000,4100,4200,42004 
160  pc  (p)*-f  :y»py  (p)  :x=px  (p)  :c*c  (p,f  )  :s=s(p,f  )  :  GOSUB 
PutCard4 
ns(p,s(p,f )  )«=ns(p,  a(p,  f  )  )-l:cL(c(p,f),s(p,f))=14 
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RETURN* 

4 

4000  IF  ns<p,tp)<>5-tk  THEN  40154 

sp=tp:BOSUB  5200: IF  f=l  THEN  GOTO  51504 

GOTO  51604 

4015  IF  (LhOl)  OR  (bdOp)  THEN  40304 

IF  ns(p,tp)>0  THEN  sp=tp:GOTO  51504 

GOTO  50504 

4030  GOSUB  5000:  IF  (-f  =  l)  AND  <ABS <bd-p> »2>  THEN  sp=t 

p:GOTO  51504 

GOSUB  5250:  IF  (fOl)  OR  (pObd)  THEN  50504 

GOSUB  5200: IF  i=l  THEN  sp«tp:GOTO  51504 

IF  ns(p,tp)>2  THEN  sp=tp:GOTO  51604 

GOTO  50504 

4100  IF  ns(p,s(Ld,pc(Ld)))»0  THEN  41154 

GOSUB  5300:sp=s(Ld,pc(Ld)):IF  f=l  THEN  51504 

GOTO  51604 

4115  IF  ns(p,tp)*5-tk  THEN  sp=tp:GOTO  51604 

IF  ns(p,tp)*0  THEN  51004 

IF   c(Ld,pc(Ld) )«5   THEN   sp=tp:GOTO   51604 

IF    bdOp    THEN    sp=tp:GOTO   51604 

GOSUB  5250: IF  f«l  THEN  sp«tp:GOTO  51604 

GOTO  51004 

4200  IF  ns(p,s(Ld,pc(Ld)))=0  THEN  42354 

sp=s(Ld,pc(Ld) >4 

IF  (spOtp)  AND  (tL-1)  THEN  51604 

IF  ABS<wp-p)<>2  THEN  42254 

GOSUB  5300: IF  f«l  THEN  GOSUB  5350: IF  f=0  THEN  51504 

GOTO  51604 

4225  GOSUB  5300: IF  f=l  THEN  51504 

GOTO  51604 

4235  IF  ns(p,tp)<5-tk  THEN  42704 

sp«tp:IF  ABS(wp-p)=2  THEN  51604 

IF  tL»0  THEN  51604 

GOSUB  5300: IF  f =1  THEN  54004 

GOTO  51604 

4270  IF  ns(p,tp)»0  THEN  51004 

IF  ABS(wp-p)<>2  THEN  43104 

IF  (tL«l)  OR  (ps«3)  THEN  51004 

IF  c(wp,pc(wp))«5  THEN  51004 

IF  c(wpfpc(wp))<4  THEN  sp-tp:GOTO  51604 

GOSUB  5250: IF  f»l  THEN  sp=tp:GOTO  51604 

GOTO  51004 

4310  IF  tL=0  THEN  sp=tp:GOTO  51604 

GOSUB  5300: IF  f=l  THEN  sp=tp:GOTO  54004 

GOTO  51004 

5000  f«0:FOR  a=0  TO  4: IF  c(p,a)>5  THEN  f=14 

NEXT: RETURN  4 

5050  f»-l:FOR  a»0  TO  4: IF  (sL (s (p, a) )=0)  AND  (s(p,a) 

Otp)  THEN  IF  c(p,a)=5  THEN  f=a4 

NEXT: IF  f>-l  THEN  50704 
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Lc— IsFOR  a=0  TO  4:  IF  s(p,a)Otp  THEN  IF  c(p,a)>Lc  T 

HEN  Lc«c(p,a):f*a4 

NEXT4 

5070  RETURN  4 

5100  IF  ns(p,tp)>0  THEN  51254 

sp=-l:FOR  a=0  TO  44 

IF  s(p,a)Otp  THEN  IF  (c(p,a)*5)  AND  (ns(p,s(p,a))>l 

)  THEN  sp=s(p,a)4 

NEXT: IF  sp>-l  THEN  51604 

GOTO  51804 

5125  v=4:f  —  1 :  FOR  a=0  TO  44 

IF  s(p,a)=tp  THEN  51354 

IF  (ns(p,5(p,a)X>l)  OR  (sL  (s  (p,  a)  )  =1 )  THEN  51354 

IF  (c(p,a)>=0)  AND  (c(p,a)<v)  THEN  v=c (p, a) : f =a4 

5135  NEXT: IF  f=-l  THEN  51804 

RETURN  4 

5150  IF  ps»3  THEN  54004 

v=-l:FOR  a=0  TO  4: IF  s(p,a)=sp  THEN  IF  c(p,a)>v  THEN 

v=c (p, a) : f =a4 
NEXT: RETURN  4 
5160  v=10:FOR  a=0  TO  44 
IF  s(p,a)=sp  THEN  IF  (c(p,a)>«0)  AND  (c(p,a)<v)  THEN 

v=c  (p,  a)  :  f =^4 
NEXT: RETURN  4 

5180  v=10:FOR  a»0  TO  4: IF  s(p,a)Otp  THEN  IF  c(p,a)> 
-1  THEN  IF  c(p,a)<v  THEN  v«c (p, a) : f-a4 
NEXT: RETURN  4 
5200  ht*8:f=04 

5205  ht=ht-l:IF  ht>0  THEN  IF  cL(ht,tp)»l  THEN  52054 
IF  ht<0  THEN  52404 

FOR  a=0  TO  4: IF  s(p,a)=tp  THEN  IF  c(p,a)=ht  THEN  f=l 
4 

NEXT  4 

5240  RETURN  4 

5250  f=l:FOR  a=0  TO  4: IF  c(p,a)>-l  THEN  IF  (s(p,a)<> 
tp)  AND  (c(p,a)<5)  THEN  f«04 
NEXT: RETURN  4 
5300  f«0:FOR  a=0  TO  4: IF  s (p, a) -» (wp, pc (wp) )  THEN  IF 

c(p,a) >c(wp,pc(wp))  THEN  f»14 
NEXT: RETURN  4 
5350  f*0:FOR  a=0  TO  4: IF  s (p, a) «s (wp, pc (wp) )  THEN  IF 

c(p,a)-c(wp,pc(wp))«l  THEN  f«14 
NEXT: RETURN  4 
5400  d«10:FOR  a»0  TO  44 
IF  s (p, a) =5 (wp, pc (wp) )  THEN  e«c (p, a) -c (wp, pc (wp) ) : IF 

(e<d)  AND  (e>0)  THEN  d~e:f«a4 
NEXT: RETURN  4 
4 

EraseCard:  PUT ( (y-1 ) *8-2, (x-1 ) *8-l ) ,ec, PSET: RETURN4 
4 
Winner: 4 
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xl=y-l:yl=x-l:x=(xl+2)*8:y=<yl+2)*8+3:xl=xl*8-3:yl=y 

1*8-24 

CIRCLE  <x,y),8,0:PAINT  <x,y),04 

FOR  i-1  TO  100:NEXT4 

FOR  i-1  TO  3:LINE  (x 1-i , yl-i ) - <xl+i+38, yl+i+42) , i+5, 

b:NEXT4 

FOR  i»3  TO  1  STEP  -1:CIRCLE  <x , y) , i *2, i+5:PAINT  <x,y 

), i+5: NEXT  4 

r«l:FOR  i»0  TO  5: r»r-. 07: cy <i >=r: NEXT4 

FOR  i  =  l  TO  50: FOR  p=l  TO  200: NEXT: j»i  MOD  64 

PALETTE  (i  MOD  3>+6,cy < j ) ,cy < j) ,0: NEXT4 

FOR  i=3  TO  1  STEP  -1:LINE  <x 1-i , yl-i )- <x l+i+38, yl+i+ 

42),0,b:FOR  j=l  TO  50: NEXT  j,i  4 

CIRCLE  <x,y),8,4:PAINT  <x,y),44 

RETURN4 

4 

InitShapes:4 

RESTORE  InitShapes4 

FOR  j«0  TO  3: FOR  i«0  TO  30:4 

READ  a*:sb(i,  j )«VAL <"8tH"+a*>  :NEXT  i,j4 

RESTORE  Hand: FOR  i*0  TO  75:4 

READ  a*:  hb  ( i  )  -VAL  ( "StH^a*)  :  NEXT:  RETURN4 

4 

Diamond:  DATA  B,9,3,400,E00, 1F00,3F80, 7FC04 

DATA  3F80 , 1 F00 , E00 , 400 , 400 , E00 , 1 F00 , 3F804 

DATA  7FC0 , 3F80 , 1 F00 , E00 , 400 , FBE0 , F 1 E0 , E0E04 

DATA  C060 , 8020 , C060 , E0E0 , F 1 E0 , FBE0 , 04 

4 

CLub:  DATA  B,  9, 3, 0,0, 0, 0, 04 

DATA  0, 0, 0, 0, E00, 1F00, 1F00, 7FC04 

DATA  FFE0 , FFE0 , 75C0 , E00 , 1 F00 , F 1 E0 , E0E0 , E0E04 

DATA  8020,0,0,8A20,F1E0,E0E0,04 

4 

Heart:  DATA  B, 9, 3, 71C0, FBE0, FFE0, FFE0, 7FC04 

DATA  3F80 , 1 F00 , E00 , 400 , 7 1 C0 , FBE0 , FFE0 , FFE04 

DATA  7FC0 , 3F80 , 1 F00 , E00 , 400 , 8E20 , 400 , 04 

DATA  0 , 8020 , C060 , E0E0 , F 1 E0 , FBE0 , 04 

4 

Spade:  DATA  B, 9, 3,0,0, 0, 0,04 

DATA  0, 0,0, 0,400, 400, E00,1F004 

DATA  3F80 , 7FC0 , 75C0 , E00 , 1 F00 , FBE0 , FBE0 , F 1 E04 

DATA  E0E0 , C060 , 8020 , 8A20 , F 1 E0 , E0E0 , 04 

4 

Hand:  4 

DATA  E,12,4,0,2C0,960,15A0,5884 

DATA  A3C, 23C, 20C, 413C, 2054, 1 168, 58, 1204 

DATA  40,140, 2A0 , 540 , A A0 , 600 , 340 , 1 9604 

DATA  C A0 , CA8 , 46AC , 66 A4 , 66 A4 , 37EC , 1 FFC , FF84 

DATA  FF8 , FF0 , FF0 , 1 7E0 , 7E0 , F60 , AA0 , FFFC4 

DATA  FFFC , FFFC , FFFC , FFFC , FFFC , FFFC , FFFC , FFFC4 
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DATA  FFFC, FFFC, FFFC, FFFC, FFFC, FFFC, FFFC, FFFC4 
DATA  FFFC , 600 , FC0 , 3FE0 , 3FE0 , 1 FFB , DFFC , EFFC4 
DATA  EFFC, FFFC, 7FFC, 3FF8, 1FF8, 1FF0, 1FF0, 1FE04 
DATA  FE0,F60,AA0,04 
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Casino  Blackjack 

John  Hamilton 
Translation  by  George  Miiier 

Win  your  ticket  home  or  iose  your  shirt  in  this  accu- 
rate simulation  of  the  most  popular  Las  Vegas  card 
game.  "Casino  Blackjack"  is  written  in  Amiga  Basic 

and  requires  512K  of  memory.  Type  in  the  listing 
and  save  a  copy  to  disk  be/ore  running  the  program. 

"Casino  Blackjack"  is  real  blackjack,  played  the  same  way  it's 
played  in  the  best  Las  Vegas  casinos.  You  start  with  a  bankroll 
of  $100  and  play  against  an  intelligent  computer  dealer.  Just 
like  in  the  casinos,  you  can  "split"  your  hand,  double  down, 
or  buy  insurance. 

In  the  Cards 

The  rules  for  Casino  Blackjack  are  simple  to  learn.  The  object 
of  the  game  is  to  get  more  points  than  the  dealer — without  ex- 
ceeding 21  points.  An  ace  can  be  counted  as  either  1  point  or 
11  points.  Jacks,  queens,  and  kings  are  all  worth  10  points.  All 
other  cards  count  as  their  face  value. 

Before  each  hand,  you  decide  how  much  of  your  bankroll 
you  want  to  bet.  Next,  four  cards  are  dealt — two  to  you  and 
two  to  the  computer  dealer.  The  dealer's  bottom  card  is  face 
down  and  the  top  card  is  face  up,  so  you  can  only  guess  at  the 
total  number  of  points  the  dealer  has.  Both  your  cards  are 
dealt  face  up. 

If  you've  been  dealt  a  blackjack  (21  points),  you  automati- 
cally win  one  and  a  half  times  your  bet,  unless  the  dealer  was 
also  dealt  a  blackjack,  in  which  case  no  money  exchanges  hands. 

After  you've  taken  a  look  at  your  cards,  decide  whether 
you  want  to  take  a  hit  (take  another  card)  or  stand  with  the 
cards  you  have.  If  you  take  a  hit  and  exceed  21  points,  you 
have  gone  bust  (lost  the  hand).  If  you  take  a  card  and  still  have 
less  than  21  points,  you're  free  to  take  another  hit  if  you  like. 
This  process  continues  until  you  stand  or  bust. 
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If  you  stand,  the  dealer  may  get  a  card.  The  dealer  takes  a 
hit  if  the  hand  has  1 6  or  fewer  points  and  stands  on  1 7  or 
more  points.  If  the  dealer  doesn't  go  bust,  the  cards  are  in- 
spected to  see  who  came  closest  to  21.  A  tie  is  known  as  a 
push.  In  the  case  of  a  push,  no  money  is  lost;  otherwise,  the 
winner  takes  the  money. 

Special  Plays 

If  the  dealer's  top  card  is  an  ace,  you  may  elect  to  insure  your- 
self against  the  dealer  having  blackjack.  You  pay  half  your 
original  bet  for  insurance.  If  the  dealer  does  have  blackjack, 
you  keep  your  bet.  You  lose  the  insurance  money,  whether 
the  dealer  has  blackjack  or  not. 

If  you're  dealt  a  total  of  10  or  11  points,  you  may  double 
your  bet.  This  is  known  as  doubling  down.  If  you  choose  to 
double  down,  you're  dealt  one  more  card,  and  then  you  auto- 
matically stand.  If  you  think  the  dealer  will  win  the  hand,  you 
may  choose  to  surrender  instead.  Surrendering  costs  half  your 
bet. 

If  you're  dealt  two  cards  of  the  same  denomination,  you 
may  elect  to  split  your  hand.  When  you  split,  you  double  your 
original  bet  and  play  the  two  cards  as  two  separate  hands,  one 
after  the  other.  Each  hand  has  a  chance  to  beat  the  dealer. 

Casino  Blackjack 

Filename:  CASINO  BLACKJACK 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTE/'s  Guide  to  Typing  In  Amiga  Programs." 

Bl ack jack: 4 

'Copyright  1988  COMPUTE!  Publications,  Inc. 4 

'All  Rights  Reserved* 

DEFINT  a-z:DEFSNG  r , g, b, cy: RANDOMIZE  TIMER* 

DIM  cd*(52) ,v*(13) ,m(52) , sb (36, 3) , card (507, 4) 4 

sp*=SPACE*(40>4 

SCREEN  1,320,200,4, 1: WINDOW  3, " " , (0, 0) - (31 1 , 186) , 16, 

1: WINDOW  OUTPUT  3: COLOR  3,04 

Start :s=l:GOSUB  DoScreen:GOSUB  InitiaLize: GOSUB  Disp 

Lay4 

Main:  IF  sOl  THEN  GOSUB  HoLdscrn4 

COLOR  ,10:CLS:GOSUB  Ti tLe: h=0: sp«0: s*04 

IF  ba<>0  THEN  4 

GOTO  DoIt4 

ELSE4 
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LOCATE  10, 10: COLOR  4, 10: PRINT  "Sorry,  you  are  broke! 

": LOCATE  12,124 

PRINT  "Play  again?  (Y/N) "4 

Answer : GOSUB  GetKey4 

IF  aS="Y"  THEN  GOTO  Start  ELSE  IF  a*~"N"  THEN  GOTO  E 

ndGame4 

GOTO  Answer* 

END  IF    4 

Dolt: COLOR  7, 10: LOCATE  6,12:4 

ba=INT(ba* 100)/ 1004 

PRINT  USING  "  Bank  =  **#######.##"; ba  4 

LOCATE  8, 12: PRINT  "Playing  Hand  #"+STR* (ha+1 ) 4 

LOCATE  10, 15: COLOR  11, 15: PRINT  "  Q  ": LOCATE  12, 15: PR 

INT  "  R  "4 

COLOR  11, 10: LOCATE  10, 19: PRINT  "to  Quit": LOCATE  12,1 

9: PR I NT  "to  Restart "4 

Get Bet: LOCATE  16,1: PR I NT  spS: COLOR  1,10: LOCATE  16,54 

INPUT  "Enter  your  bet "; bets :bet= INT (VAL( bet*) * 100) /l 

004 

bet*»UCASE* (bets) 4 

IF  LEFTS (bets, 1)="Q"  THEN  GOTO  EndGame4 

IF  LEFT* (bet*, 1)="R"  THEN  CLS:GOTO  Start4 

IF  bet<«0  OR  bet>ba  THEN  GOTO  GetBet4 

GOSUB  GameScreen:IF  h-1  GOTO  Main4 

ChecKey: GOSUB  GetKey4 

IF  a*«"P"  THEN  GOSUB  SpLit4 

IF  a*="D"  THEN  GOSUB  DoubLe4 

IF  a*»"H"  THEN  GOSUB  Hit 4 

IF  a*="S"  THEN  GOSUB  Stand: GOTO  Main4 

IF  a*«"E"  THEN  ba»ba-bet*. 5: GOTO  Main4 

IF  h-1  THEN  h*0:GOTO  Main4 

GOTO  ChecKey4 

DeLay:FOR  i=l  TO  5000: NEXT: RETURN4 

Stand: GOSUB  ShowDeaLer : GOSUB  VdeaLer4 

IF  spOl  THEN  COLOR  4,10:LOCATE  py+2, px : PRINT  "Stand 

": GOSUB  PvaLue: GOSUB  VdeaLer4 

IF  dtl=21  AND  d=2  THEN  LOCATE  dy+2, dx : PRINT  "Black ja 

c  k ! " : h« 1 : ba«ba-bet : RETURN4 

DeaLerpLays: 4 

IF  dtl>21  THEN4 

LOCATE  dy+2,dx: COLOR  4, 10: PRINT  "Busted !": ba=ba+bet: 

GOSUB  Pwin:h=14 

RETURN4 

END  IF4 

IF  dtl<17  OR  dt2<17  THEN  GOSUB  GetCard: GOSUB  VdeaLer 

:GOTO  DeaLerpLays4 

GOSUB  CheckCards:RETURN4 

GetCard: FOR  t*  1  TO  3000:NEXT4 

c«c+l:dl*(d)=cd*(m(c) > : tp*=dl* (d) :d=d+l :c*c+l:x=dx*8 

-l:y-dy*8-114 

xL»dx : yL«dy: dx-dx+6: GOSUB  ShowCard: RETURN4 
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CheckCards:* 

IF  sp-1  THEN  GOSUB  SpLitHand* 

IF  dtl<-21  THEN  dt«dtl  ELSE  dt«dt2* 

IF  dt2>dtl  AND  dt2«21  THEN  dt=dt2* 

IF  ptl<«21  THEN  pt«ptl  ELSE  pt»pt2* 

IF  pt2>ptl  AND  pt2<«21  THEN  pt~pt2* 

COLOR  4, 10: IF  dt=pt  THEN  LOCATE  12,10sPRINT  "Push,  N 

o  winner" : GOSUB  DeLay* 

IF  dt>pt  AND  dt<=21  THEN  GOSUB  HouseWin: ba«ba-bet* 

IF  pt>dt  AND  pt<=21  THEN  GOSUB  Pwin:ba=ba+bet* 

RETURN* 

SpLitHand:* 

IF  vtl<=21  AND  ptl<=21  AND  vtl>ptl  THEN  ptl=vtl* 

IF  vt2<=21  AND  pt2<=21  AND  vt2>pt2  THEN  pt2*vt2* 

RETURN* 

Hit:c=c+l:pl*<p)«cd*<m<c> ) :tp*=pl*(p> :p=p+l: x=px*8-l 

: y«py*8-4: xL*px* 

yL»py+l :  pxaBpx+6* 

GOSUB  ShowCard: GOSUB  PvaLue* 

IF  ptl>21  AND  pt2>21  THEN  * 

LOCATE  py+2,px: COLOR  4, 10: PRINT  "Busted ! "* 

IF  sp=0  THEN* 

GOSUB  ShowDeaLer: GOSUB  HouseWin: ba=ba-bet : GOSUB  DeLa 

y:h»l* 

ELSE* 

sp«0* 

END  IF* 

END  IF* 

RETURN* 

DoubLe:* 

GOSUB  PvaLue:IF  ptl<10  OR  ptl>ll  THEN  a*«"" : RETURN* 

LOCATE  10, 12: COLOR  4, 10: PRINT  "Double  Down !": bet =bet 

*2: GOSUB  Hi t: a*="S" : RETURN* 

ShowDeaLer : x=l *8-l : y=5*8-l 1 : xL=l : yL=5: tp*=dl* (0) : GOS 

UB  ShowCard: RETURN* 

HouseWin: LOCATE  dy+2, dx : COLOR  4, 10: PRINT  "House  Wins 

! " : RETURN* 

Pwin: LOCATE  py+2, px: COLOR  4, 10: PRINT  "Winner !": RETUR 

N 

* 
PvaLue: pt2=0:pt 1=0: FOR  x=0  TO  p-l:g*=pl* (x) : GOSUB  Va 
Lue:ptl=ptl+vl* 
pt2=pt2+v2: NEXT: RETURN* 

VdeaLer:dt2=0:dtl«0:FOR  x»0  TO  d-l:g*=dl*<x> : GOSUB  V 
aLue:dtl=dtl+vl* 
dt2=dt2+v2:NEXT* 
IF  dtl<21  THEN  dt2«dtl* 
IF  dtl>21  THEN  dtl=dt2* 
RETURN* 

VaLue: vl*0: v2=0:FOR  y*l  TO  13* 
IF  LEFT*<g$, l)=v*(y)  THEN  v=y+l* 
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NEXT* 

IF  v»14  THEN  vl=ll:v2=l: RETURN* 

IF  v>10  THEN  vl=10:v2=10: RETURN* 

vl=v: v2«v* 

RETURN* 

SpLit:* 

IF    LEFT*<pl*<0)  ,  l)OLEFT*<pl*<l>  ,1)     THEN    RETURN* 

LINE<55, 124)-<88, 160) , 10, bf :r=0* 

c*c+l  :sp=l:px=l:py=10: tp*=pl*(l ) :x*px*8-l : y*py*8-4: x 

L=px* 

yL=py+l :  p=2:  GOSUB   ShowCard: px*px +6* 

temp*=pl*<0>:pl*<0>=pl*<l):pl*<l>=cd*<m<c)>:c==c+l:tp 

*=pl*(l>* 

x=px*8-l :  y=py*8-4:xLs=px:  yL=py+l : GOSUB  ShowCard :pxspx 

+6:* 

pt 1=0: pt2=0:p=2: GOSUB  PvaLue* 

SpLitLup: GOSUB  GetKey* 

IF  a*»"H"  THEN  GOSUB  SPHit* 

IF  a*«"S"  AND  r«l  THEN   COLOR  4,10:LOCATE  py+2,px:PR 

INT  "Stand": RETURN* 

IF  a*«"S"  AND  r»0  THEN  vtl=ptl : vt2*pt2: COLOR  4,10:LO 

GATE  py+2,px: PRINT  "Stand": GOSUB  SecondHand* 

IF  ptl>21  AND  pt2>21  THEN  * 

LOCATE  py+2,px:C0L0R  4,10:PRINT  "Busted ! ":a*=" "* 

IF  r»l  THEN  a*»"S": RETURN* 

IF  r»0  THEN  vtl-ptl: vt2=pt2: GOSUB  SecondHand* 

END  IF* 

GOTO  SpLitLup* 

SPHit:c«c+l:pl*(p>«cd*<m<c>>:tp*=pl*<p>:x«px*8-l:y=p 

y*8-4* 

xL=px : yL=py+l : px=px+6* 

GOSUB  ShowCard: p=p+l: GOSUB  PvaLue* 

RETURN* 

SecondHand:* 

pt 1-0: pt2«0: r»l : px«7: py«16: pi*  <0) =temp*: c«c+l  : pi*  < 1 ) 

=cd*<m<c)):p«2* 

tp*=pl *  < 1 ) : x*px*8-l : y«py*8-4: xL»px : yL*py+l : px«px+6: G 

OSUB  ShowCard: GOSUB  PvaLue:LOCATE  1,1:PRINT  ptl,pt2: 

RETURN* 

GameScreen: GOSUB  Snuff LeCards:CLS: GOSUB  TitLe* 

FOR  i»0  TO  3:  j-i*2:LINE<l+j,  168+j)-<310-j, 190-j> , i+1 

2,bf :NEXT* 

COLOR  2, 15:L0CATE  23,3:PRINT  "it   tand   ouble-down  S 

lit  Surr  nder"* 
COLOR  12, 15: LOCATE  23, 2: PRINT  "H": LOCATE  23, 6: PRINT 
" S " : LOCATE  23  12: PR I NT  " D " * 

LOCATE  23, 25: PRINT  "p": LOCATE  23, 34: PRINT  "e":p«0:d« 
0* 

dx»l:dy«=5:px«l:py=16:F0R  i»l  TO  4: tp*»cd*(m(i ) )* 
IF  i«l  OR  i-3  THEN* 
x=px*8-l : y«py*8-4: xL=px : yL^py+l : px=px+6: pi* (p) =tp*: p 
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«p+14 

ELSE  4 

x=dx  *8-l : y=dy*8-l 1 : xL=dx : yL=dy : dx=dx+6: dl * (d ) =tp*: d= 

d+14 

END    IF4 

IF    i=2   THEN    tp*="       "4 

GOSUB  ShowCard:NEXT:c»44 

Insurance: 4 

IF  LEFT*<dl*<l> , 1>="A"  THEN4 

LOCATE  12,12:C0L0R  4,10:PRINT  "Purchase  insurance?  ( 

Y/N>": GOSUB  GetKey4 

LOCATE  12,1: PRINT  sp*:4 

IF  a$«"Y"  THEN4 

IF  bet -bet-bet *.5<ba  THEN4 

i  ns* 1 : ba«ba-bet » -  54 

ELSE4 

LOCATE  12,1:PRINT  "You  can't  afford  insurance. " : GOSU 

B  DeLay4 

LOCATE  12,1: PRINT  sp*4 

END  IF4 

ELSE4 

IF  a*<>"N"  THEN4 

GOTO  Insurance^ 

END  IF    4 

END  IF4 

GOSUB  VdeaLer:4 

IF  dtl*21  THEN  4 

h=l:GOSUB  ShowDeaLer : LOCATE  dy+2, dx :COLOR  4,10:PRINT 

"Blackjack !":GOSUB  DeLay: ba=ba-bet4 
IF  insOl  THEN  ba=ba-bet: RETURN  ELSE  RETURN4 
ELSE4 

LOCATE  12, 8: PRINT  "Dealer  does  not  have  Black  jack ":G 
OSUB  DeLay4 

LOCATE  12,1: PRINT  sp*4 
END  IF4 
END  IF4 
GOSUB  PvaLue4 
IF  ptl*21  AND  p=2  THEN4 

COLOR  4, 10: LOCATE  py+2, px : PRINT  "Black jack !": h=l : GOS 
UB  ShowDeaLer: GOSUB  VdeaLer4 
IF  dt2<>21  THEN4 

ba*bet *  1 . 5+ba : GOSUB  DeLay : RETURN4 
ELSE4 
LOCATE  dy+2, dx: PRINT  "Black jack !": LOCATE  12, 10: PRINT 

"Push,  No  winner":h=l: GOSUB  DeLay 4 
END  IF4 
END  IF4 
GOSUB  DeLay4 
RETURN4 
ShowCard:4 
IF  tp*«"   "  THEN  PUT  (x , y) , card (0, 4) , PSET: RETURN4 
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j*ASC (RIGHT*  (tp*, 1 ) ) -654 

PUT  (x, y), card (0,j),PSET: COLOR  1,44 

LOCATE  yL,xL+l: PRINT  LEFT* (tp*, 1 ) : LOCATE  yL+3,xL+4:P 

RINT  LEFT* (tp*, 1)4 

RETURN4 

TitLe:FOR  1*0  TO  3: j-i *2:LINE (64+j, j) -(256-j, 23-j) , i 

+12,bf:NEXT4 

COLOR  2,15:  LOCATE  2,13:PRINT  "Casino   Black jack": RE 

TURN4 

Get  Key : a*= I NKE Y*4 

IF  a*<>""  THEN4 

a**UCASE*(a*)4 

ELSE4 

GOTO  GetKey4 

END  IF4 

RETURN4 

Shuf*LeCards:FOR  i=l  TO  52: m(i )=i : NEXT: FOR  i=l  TO  52 

:x«INT(52*RND)+14 

tp«m (i )  :  m  ( i  )  =m  (x  ) :  m  (x  ) =tp: NEXT: CLS: ha»ha+l : RETURN4 

InitiaLize:ha»0:GOSUB  InitShapes:ba=100: RESTORE  card 

s:FOR  x=0  TO  34 

FOR  t«l  TO  13:READ  cd* (x*13+t ) :cd* (x*13+t) *cd* (x*13+ 

t)+CHR*(x+65>4 

NEXT: RESTORE  cards: NEXT: FOR  t  *  13  TO  1  STEP-1:READ 

v* ( t ) : NEXT: RETURN4 

cards: DATA  A, K,Q, J, T, 9,8, 7,6,5, 4, 3, 24 

DispLay: WIDTH  40: CLS: COLOR  ,04 

FOR  x«0  TO  3: LINE  (80+x*2,40+x*2) - (225-x*2, 63-x*2> , 1 

2+x,bf :NEXT4 

COLOR  2, 15: LOCATE  7, 12: PRINT  "Casino  Black jack"4 

COLOR  2,10:LOCATE  12,4:PRINT  "Copyright  1988  COMPUTE 

!  Pub.,  Inc. "4 

LOCATE  13,11:PRINT  "All  Rights  Reserved" : FOR  x=  1  TO 

10:GOSUB  DeLay:NEXT4 
COLOR  4,0:RETURN4 

InitShapes: RESTORE  Ini tShapes: check=04 
LINE (4,4) -(37, 40), 12, bf: GET  (4, 4) - (37,40) , card (0, 4) : 
FOR  j«0  TO  3: FOR  i=0  TO  304 

READ  a*: sb ( i , j ) -VAL ( "&H"+a*> : check*check+sb ( i , j ) : NEX 
T  i,j4 

IF  check<>1787488c  THEN  PRINT  "Error  in  Shape  Data":G 
OSUB  DeLay:ST0P4 
FOR  j=0  TO  34 

LINE(4,4)-(37,40),4,bf : PUT  ( 14, 6) , sb (0, j ) , PSET:PUT  ( 
17,30),sb(0, j),PSET4 

GET  (4, 4) -(37, 40), card (0, j):CLS:NEXT  j:RETURN4 
d i  amond : DATA  B , 9 , 3 , 400 , E00 , 1 F00 , 3F80 , 7FC04 
DATA  3F80, 1F00, E00, 400, 400, E00, 1F00, 3F804 
DATA  7FC0 , 3F80 , 1 F00 , E00 , 400 , FBE0 , F 1 E0 , E0E04 
DATA  C060 , 8020 , C060 , E0E0 , F 1 E0 , FBE0 , 04 
CLub:DATA  B, 9, 3, 0, 0, 0, 0, 04 
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DATA   0,0,0,0,E00,1F00,1F00,7FC04 

DATA  FFE0 , FFE0 , 75C0 , E00 , 1 F00 , F 1 E0 , E0E0 , E0E04 

DATA  8020,0,0,8A20,F1E0,E0E0,04 

Heart : DATA  B, 9, 3, 71C0, FBE0, FFE0, FFE0, 7FC04 

DATA  3F80 , 1 F00 , E00 , 400 , 7 1 C0 , FBE0 , FFE0 , FFE04 

DATA  7FC0 , 3F80 , 1 F00 , E00 , 400 , 8E20 , 400 , 04 

DATA  0  y  8020 , C060 , E0E0 , F 1 E0 , FBE0 , 04 

Spade: DATA  Bf 9, 3,0, 0,0,0, 04 

DATA  0, 0,0, 0,400, 400, E00, 1F004 

DATA  3F80 , 7FC0 , 75C0 , E00 , 1 F00 , FBE0 , FBE0 , F 1 E04 

DATA  E0E0 , C060 , 8020 , 8A20 , F 1 E0 , E0E0 , 04 

DoScreen: WINDOW  OUTPUT  3: COLOR  3,0: WIDTH  40: RESTORE 

PaLetteData4 

FOR  i-0  TO  15:READ  r, g, b: PALETTE  i , r, g, b: NEXT: RETURN 

4 

PaLetteDatas  DATA  0, . 7, 0, 0,0, 0,0,0,0,1,0,0,1,1,1,0,0, 

0,1,0,0, 1,1,1,0,0,04 

DATA  1,0,0,0,.7,0,1,0,0,1,0,0,1,.5,.1,1,.7,.1,1,.6,. 

14 

HoLdscrn: LOCATE  12,6:C0L0R  5,10:PRINT  "Press  any  key 

to  continue ":GOSUB  SetKey: RETURN4 

EndGame:CLS: COLOR  1,10:LOCATE  12,10:PRINT  "Thank  you 

for  playing": COLOR  114 
LOCATE  14,  12:  PRINT  "Casino  Black  jack" :  GOSUB  DeLay-.WI 
NDOW  CLOSE  34 
SCREEN  CLOSE  1 : END4 
4 
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Canfield 

Ed  Reynolds 
Translation  by  George  Miller 


Play  a  hand  of  this  high-stakes  turn-o/-the-century 

solitaire  game  on  your  computer.  You  start  with 

$500,  and  Fortune  is  beckoning.  You  can  break  the 

bank  or  lose  your  shirt  in  one  of  the  best  computer 

card  games  we've  ever  published. 


Among  the  many  games  that  people  play,  solitaire  card  games 
have  long  been  among  the  most  popular.  Such  games  are 
ideal  candidates  for  computerization.  With  this  in  mind,  I  set 
out  to  find  a  unique  solitaire  game.  After  a  bit  of  research,  I 
discovered  Canfield,  a  game  that  was  in  vogue  around  the  turn 
of  the  century.  Although  I  did  eventually  find  a  few  people 
who  still  play  the  game,  it  is  basically  unknown  nowadays. 
Canfield  is  as  intriguing  and  challenging  as  any  solitaire  game 
around,  and  it  has  a  fascinating  history. 

In  the  latter  part  of  the  nineteenth  century,  there  existed 
in  Saratoga  Springs,  New  York,  a  lavish  casino — the  Saratoga 
Springs  Club  House.  It  was  known  as  the  "Monte  Carlo  of 
America"  and  entertained  European  royalty,  U.S.  senators, 
and  scores  of  American  millionaires.  Its  founder  and  propri- 
etor, Richard  A.  Canfield,  retired  a  multimillionaire  when  a 
wave  of  antigambling  sentiment  eventually  caused  the  perma- 
nent closing  of  the  casino  in  1914. 

One  of  the  more  popular  games  offered  by  the  casino  was 
a  solitaire  game  invented  by  and  named  after  the  casino's 
founder.  The  player  would  purchase  a  deck  of  cards  from  the 
casino  for  $50  (a  princely  sum  in  those  days).  Under  the 
watchful  eye  of  one  of  Mr.  Canfield's  croupiers,  the  player 
would  deal  the  layout  and  try  to  beat  the  odds.  The  object 
was  to  get  all  52  cards  (or  as  many  as  possible)  on  four  foun- 
dation piles.  For  each  card  placed  upon  a  foundation  pile,  the 
player  would  receive  $5.  Sound  simple?  Just  wait. 

This  version  of  Canfield  is  written  in  Amiga  Basic.  Type  it 
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in  and  save  a  copy  before  playing  it.  Press  Fl  to  quit.  Press 
F10  to  start  a  new  game  with  a  new  deck. 

The  computerized  version  of  Canfield  presented  here  pre- 
serves the  spirit  of  the  original  game,  but  the  tedious  tasks  of 
shuffling  and  dealing  the  layout  have  been  usurped  by  the 
computer. 

As  with  all  card  games,  Canfield's  rules  seem  more  com- 
plicated in  print  than  when  you're  playing  the  game.  Since  the 
computer  won't  let  you  make  an  illegal  move,  you  can  learn 
to  play  by  trial  and  error.  For  those  who  want  to  know  what 
they're  getting  into,  complete  rules  are  presented  below. 

The  Rules  of  the  Game 

A  standard  deck  of  52  cards  is  shuffled.  (In  the  computer  ver- 
sion, a  T  is  used  to  designate  the  number  10  cards.)  Then,  13 
cards  are  counted  off,  face  down,  into  a  pile,  which  is  then 
placed  face  up  to  the  player's  left,  to  form  the  stock.  One  card 
is  dealt  face  up  above  and  to  the  right  of  the  stock  for  the  first 
foundation.  Then,  four  cards  are  placed  face  up  in  a  row,  to 
the  right  of  the  stock,  to  form  the  tableau.  The  remaining  34 
cards  (held  face  down)  constitute  the  pack. 

In  play,  the  cards  in  the  pack  are  turned  up  in  batches  of 
three  and  placed  on  a  talon  pile  to  the  right  of  the  pack.  The 
top  card  of  the  talon  is  available  for  play.  When  all  of  the  pack 
has  been  played  onto  the  talon,  the  cards  are  then  turned  over 
and  become  the  pack  once  again. 

The  other  three  cards  of  the  same  rank  as  the  first  foun- 
dation card  are  also  foundation  cards  and,  if  they  become 
available  during  play,  must  be  placed  up  alongside  the  first. 
You  must  then  build  up  on  the  foundations  in  suit  and  se- 
quence until  each  foundation  pile  contains  13  cards. 

Note  that  the  ranking  in  each  suit  is  circular — the  ranking 
wraps  around  the  king  and  ace.  For  example,  if  the  queen  of 
hearts  is  the  foundation,  you  would  build  hearts  on  this  pile 
by  playing  next  the  king,  then  the  ace,  then  the  deuce,  and  so 
on.  Your  computer  will  give  you  a  little  help  here.  Whenever  a 
foundation  card  is  exposed  during  play,  the  program  will  auto- 
matically place  the  card  in  the  proper  place  in  the  foundation 
row. 
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On  the  tableau  piles,  you  build  downward  in  alternate 
colors.  The  top  cards  can  be  played  only  on  foundations.  To 
build  on  another  tableau  pile,  you  must  move  an  entire  pile  as 
a  unit.  If  any  pile  is  moved  away  leaving  a  space,  the  top  card 
of  the  stock  must  be  used  to  fill  the  space.  Here  again,  your 
computer  will  help  by  moving  the  card  automatically  until  the 
stock  is  exhausted.  Once  the  stock  is  exhausted,  spaces  can  be 
filled  from  the  talon,  but  at  this  time,  a  space  may  be  kept 
open  as  long  as  you  want. 

In  this  version  of  Canfield,  your  computer  will  shuffle  the 
deck  and  deal  the  layout.  You  move  cards  to  and  from  screen 
locations  by  pressing  specific  keys  (see  Table  2-1). 

Table  2-1.  Keypress  Reference  Guide 

Key  Action 

S  Move  a  card  from  the  stock 

T  Move  a  card  from  the  talon 

F  Move  a  card  to  its  foundation 

P  Turn  over  the  pack  of  cards 

1  Move  a  card  to  or  from  tableau  1 

2  Move  a  card  to  or  from  tableau  2 

3  Move  a  card  to  or  from  tableau  3 

4  Move  a  card  to  or  from  tableau  4 

Computer  Canfield 

Canfield  provides  a  way  for  you  to  keep  your  money  across 
games.  To  accomplish  this,  Canfield  checks  a  data  file  on  disk 
to  see  how  much  money  you  had  when  you  last  quit  the 
game.  When  you're  asked  for  your  name,  that  name  will  be 
used  as  a  filename  to  store  your  account  on  disk.  If  it's  your 
first  game,  or  if  you  drop  to  $0,  youTl  start  with  $500.  Re- 
member that  it  costs  $50  to  buy  a  deck  of  cards  to  play  the 
game. 
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Canfield 

Filename:  CANFIELD 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
" COMPUTE!' s  Guide  to  Typing  In  Amiga  Programs." 

4 

*  COPYRIGHT  (C)  1988  COMPUTE!  PUBLICATIONS,  INC. 4 

ALL  RIGHTS  RESERVED* 
DEFINT  a-Z:DEFSNG  r, g,b: RANDOMIZE  TIMER4 
DIM  sb(36,3> ,CD*(52> ,M(52) ,ST*(13> ,FD*(4, 13) ,TB*(4,2 
5>,pk*(34),v*(13>4 
t*="   "4 
4 

INPUT "What  is  your  name";NAM*4 
yorn: 4 

PRINT  "Do  you  have  an  account" ;: INPUT  yorn*4 
IF  UCASE* (LEFT* (yorn*, 1) )«"Y"  THEN4 

OPEN  NAM*  FOR  INPUT  AS  #14 

INPUT#l,bank4 

CLOSE  1  4 
ELSE4 

IF  UCASE* (LEFT* (yorn*, 1))<>"N"  THEN  yorn4 
END  IF4 

GOSUB  DoScreen4 
GOSUB  InitiaLize4 
GOSUB  GameScreen4 
ChecKey: 4 

GOSUB  CheckTotaL: GOSUB  GetKey4 
IF  key- 129  THEN  endgame4 

IF  key-138  THEN  GOSUB  Busted: GOSUB  GameScreen: GOTO  C 
hecKey4 

COLOR  2, 15: LOCATE  22, 9: PRINT  a*4 
IF  a*="P"  THEN  GOSUB  PacK:GOTO  ChecKey4 
IF  a**"T"  THEN  GOSUB  DoTalon:GOTO  ChecKey4 
IF  a*>*"l"  AND  a*<«"4"  THEN  GOSUB  TtoTA:GOTO  ChecKey 
4 

IF  a**"S"  THEN  GOSUB  StackPLay: GOTO  ChecKey  ELSE  Che 
cKey4 
4 

GameScreen: 4 

COLOR  2,10:CLS:WIDTH  404 

FOR  c«0  TO  2:F0R  x»0  TO  3:LINE  (200+x*2, 20+ (70*c> +x* 
2) - (305-x *2, 70+ (60*c ) -x *2> , 12+x , bf : NEXT  x , c4 
COLOR  2, 15: LOCATE  5, 27: PRINT"F1   Quit": LOCATE  7,27:P 
RINT"F10  Concede"4 

LOCATE  14,28:C0L0R  12,15:PRINT  "Canfield"4 
COLOR  2, 10: LOCATE  1,9: PRINT  "oundat i on ": LOCATE  5,94 
PRINT" 1    2    3    4": LOCATE  9, 2: PRINT" tock": LOCATE  2 
2,284 

COLOR  2,15:PRINT"Bankroll"4 
bank=bank-50: LOCATE  23, 29: PRINT"*" ; bank4 
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FOR  x=0  TO  3:LINE  <9+x*2, 160+x*2> -<77-x*2, 191-x*2> , 1 

2+x,bf:NEXT  x4 

LOCATE  22,3:PRII\IT"From:  ":  LOCATE  23,  5:  PRINT"To:  "4 

COLOR  2, 10: LOCATE  23, 13: PRINT"ack" ;: LOCATE  23,18:PRI 

NT"alon";4 

COLOR  3, 10: LOCATE  1 , 8: PRINT"F" : LOCATE  9, 1 : PRINT'S": L 

OCATE  23,12:PRINT"P"4 

LOCATE  23, 17: PRINT"T" : COLOR  2,104 

GOSUB  ShuffLeDeck4 

4 

RETURN4 

4 

CheckTotaL:4 

COLOR  2, 15: LOCATE  22, 9: PRINT"  ": LOCATE  23, 9: PRINT"  " 

;« 

TOTAL*0:FOR  y=l  TO  SU  : TOTAL-TOT AL+F (y) : NEXT: IF  TOTA 
L<52  THEN  RETURN4 

CLS:COLOR  14,1:L0CATE  8, 10: PRINT"Congratulations,  "p 
layer*" ! "4 

LOCATE    10,7:PRINT"YoLTve    beaten    the   odds!"4 
LOCATE    12, 10:PRINT"Play    again    (Y/N)?"4 
GOSUB   Get Key: 4 
rs:4 

IF   a*-"Y"    THEN4 

GOSUB  GameScreen:GOTO  ChecKey4 
ELSE IF  a*="N"  THEN4 
endgame4 
ELSE  4 
GOTO  rs4 
END  IF4 
4 

Busted: 4 

IF  bank>50  THEN  RETURN4 

CLS: COLOR  1,15: LOCATE  10, 20: PRINT"Sorry,  you  only  ha 
ve  *";bank;"  remaining- ": LOCATE  12, 20: PRINT" Would  yo 
u  like  to  play  again?  (y/n)"4 
Brs:4 

GOSUB  Get Key: IF  a*="Y"  THEN  4 
bank=500:GOTO  GameScreen: GOTO  ChecKey4 
ELSE IF  a*="N"  THEN4 
GOTO  endgame4 
ELSE4 
GOTO  Brs4 
END  IF4 
4 

InitiaLize:4 

WIDTH  40: COLOR  2,10:CLS4 

FOR  x-0  TO  3: LINE  ( 100+x*2, 40+x*2> - <205-x*2, 63-x*2> , 
12+x,bf:NEXT  x4 

COLOR  2,15:L0CATE  7,16:PRINT  "Canf ield"4 
COLOR  2,10:LOCATE  14, 4:PRINT"Copyright  1988  COMPUTE! 
Pub-,  Inc-"4 
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LOCATE  15,11:PRINT"A11  Rights  Reserved": 4 

4 

SetBank:4 

IF  bank<-0  THEN  bank-5004 

RESTORE  cards4 

FOR  x-0  TO  3s FOR  t-1  TO  134 

READ  CD*(x*13+t) x CD* (x*13+t) -CD* (x*13+t ) +CHR*(x+65) : 

NEXT4 

RESTORE  cards: NEXT4 

FOR  t-13  TO  1  STEP-1:READ  v*(t):NEXT:4 

GOSUB  InitShapes4 

RETURN4 

4 

cards: 4 

DATA  A,K,Q,J,T,9,8,7,6,5,4,3,24 

4 

ShuffLeDecks4 

LOCATE  15,5:C0L0R  2, 10: PRINT"Shuf f 1 ing  Deck. ..": FOR 

i-1  TO  52:M(i)-i:NEXT:F0R  i»l  TO  52:  x-INT  (52*RND)  +1 : 

tp«M (i ) : M (i ) «M (x ) : M (x ) -tp: NEXT4 

LOCATE  15, 5: PRINT"  ": pk-34: TN-04 

FOR  x  =  l  TO  13:ST*(x)=CD*(N(x)):NEXT:tp*-ST*(13)4 

xL-10:yL»2: GOSUB  ShowCard: ST- 13: ST* (0) -"   "4 

FD* (1,1) -CD* (M ( 14) ) : tp*-FD* (1,1): xL«2: yL«74 

GOSUB  ShowCard: F-7:SU»1: GOSUB  VBank: FOR  x  =  15  TO  184 

TB* (x-14, 1 ) -CD* (M (x ) ) : NEXT4 

FOR  x-19  TO  52:pk*(x-18)-CD*(M(x)):NEXT:pk*(0)«"   "4 

GOSUB  ShowDeck4 

4 

xL«6:F0R  Q-l  TO  4  : tp*-TB* (Q, 1 ) : t (Q) -1 : F (Q) -04 

yL«5+ (4*Q) : GOSUB  ShowCard: NEXT: F ( 1 ) -14 

STtoFD:4 

IF  LEFT*(ST*(ST),l)OLEFT*(FD*(l,l),l)  THEN  SetT4 

GOSUB  DeLaY:SU=SU+l:FD*(SU,l)-ST*(ST):GOSUB  NewSuit4 

GOSUB  DeLaY: i -SU: F-F+4: tp*=ST* (ST) : xL-2: yL=F4 

GOSUB  ShowCard: GOSUB  VBank: ST-ST- 14 

tp*-ST* (ST) :xL»10:yL-2: GOSUB  ShowCard:GOTO  STtoFD4 

SetT:4 

t=04 

TltF:4 

t-t-i-1 :  tp*«TB*  ( t ,  1 )  :  IF  LEFT*  ( tp*,  1 )  -LEFT*  (FD*  ( 1 ,  1 )  ,  1 ) 

THEN  Set 14 
IF  t<4  THEN  TltF  ELSE  RETURN4 
Setl:4 

i-t: GOSUB  DeLaY: GOSUB  AddSuit: GOSUB  ShowCard4 
GOSUB  VBank: GOSUB  YcalC:tp*="   ": GOSUB  ShowCard4 
STK:4 

IF  STO0  THEN  4 

tp*-ST* (ST): GOSUB  YcalC:GOSUB  ShowCard4 
ST-ST- 1 : TB* ( t , 1 ) -tp*: tp*«ST* (ST) : xL-10: yL-24 
GOSUB  ShowCard: GOTO  STtoFD4 
END  IF4 
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AddSuit:4 

SU«SU+1:FD*<SU, l)=tp*:  LOCATE  20, 18: COLOR  2, 10: PRINT 

TN4 

BOSUB  NewSui  t : F-F+4: xL«2: yL-F: RETURN* 

YcalC:4 

xL«6: yL»5+  < t*4) : RETURN4 

4 

PacK:4 

IF  pk=0  THEN  pk»TN:TN=04 

IF  pk<3  THEN  TN=TN+pk: pk*0  ELSE  pk=pk-3: TN-TN+3: GOSU 

B  ShowDeck:GOTO  PTaLon4 

4 

PBLank:4 

xL«21:yL= 12: COLOR  7,6:tp*«M   " : GOSUB  ShowCard4 

COLOR  2,0: LOCATE  20, 11: IF  pk<>0  THEN  PRINT  pk  ELSE  P 

RINT  "   "4 

GOSUB  ShowDeck4 

4 

PTaLon:4 

xL*21 : yL=19: tp*=pk* (TN) : GOSUB  ShowCard4 

LOCATE  20, 18: COLOR  2,0: PRINT  TN4 

IF  LEFT*(tp*,  l)OLEFT*(FD*(l,  1),  1)  THEN  RETURN* 

TN=TN-1:IF  TNO0  THEN  GOSUB  I  Suit  4 

IF  TN*0  THEN  xL=20: yL= 18: COLOR  0,2:tp*="   " : PRINT  tp 

*:xL=21:yL=19: GOSUB  ShowCard4 

IF  pk«0  THEN  xL=20:yL» 15: COLOR  0,2:tp*="   ": GOSUB  Sh 

owCard4 

GOTO  PBLank4 

4 

ISuit:4 

SU»SU+l:FD*(SU,l)=tp*: LOCATE  20, 18: COLOR  2,0: PRINT  T 

N: GOSUB  NewSui t: GOSUB  DeLaY4 

F»F+4:xL=2:yL=F: GOSUB  ShowCard: GOSUB  VBank4 

IF  TN>0  THEN  tp*=pk* <TN) : xL=21 : yL= 19: GOSUB  ShowCard: 

GOSUB  ShowDeck4 

DPack:4 

FOR  i=TN+l  TO  33: t=i+l :pk* <i )=pk* <t) : NEXT: RETURN4 

4 

DoTalon:4 

GOSUB  Get Key 4 

a=VAL(a*) : COLOR  2, 15: LOCATE  23, 9: PRINT  a*: tp$=pk*(TN 

)  4 

IF  a>-l  AND  a<=4  AND  t(a)=0  THEN  TB* <a, 1 ) =tp$:GOTO  N 

ewCard4 

IF  a$="F"  THEN  GOSUB  ChkFDTP: IF  HIT=1  THEN  GOSUB  LTa 

Lon:HIT=04 

IF  a*0  THEN  RETURN4 

r=a:y=t(a):IF  a>=l  OR  a<=4  THEN  GOSUB  ChkTable:IF  HI 

T=l  THEN  GOSUB  TnMiN4 

GOSUB  ShowDeck4 

RETURN4 

4 
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NewCard:4 

xL=6:yL=5+(4*a)  :  t  (a)  =1 :  GOSUB  TnMiNrIF  TN=0  THEN  GOSU 

B  NCard  ELSE  RETURN* 

4 

NCard: 4 

tp*=M   M:xL=21:yL«19: GOSUB  ShowCard4 

IF  pk<>0  THEN  GOSUB  ShowDeck4 

RETURN4 

4 

DeLaY:4 

4 

FOR  D«L«Y»0  TO  VaLCiNEXTi RETURN* 

4 

ShowCard:4 

COLOR  10, 10: LOCATE  xL,yL: PRINT  t*: GOSUB  CheckCoLor4 

IF  tp*=M   "  THEN4 

GOTO  Space4 

END  IF4 

LOCATE  xL,yL: PRINT  LEFT* <tp*, 1 ) 4 

x=yL*8: y=xL*8-8: j=ASC (RIGHT* (tp*, 1 ) ) -654 

PUT  <x , y ) , sb (0, j ) , PSET4 

PUT  <x-8,y+8) ,sb(0, j) ,PSET4 

LOCATE  xL+l,yL+l: PRINT  LEFT* <tp*, 1 >  :  RETURN4 

Space: 4 

COLOR  10, 10: LOCATE  xL,yL: PRINT  tp*s LOCATE  xL+lfyL:PR 

INT  tp*:RETURN4 

4 

4 

CheckCoLor:4 

IF  tp*="   "  THEN  COLOR  5f6:RETURN4 

IF  RIGHT* (tp*,l)=CHR* (65)  OR  RIGHT* (tp*, 1 ) »CHR* (66) 

THEN4 

COLOR  12,24 

ELSE4 

COLOR  5,24 

END  IF4 

RETURN4 

4 

VBank:  bank«bank+5: COLOR  2,15:L0CATE  23,29:PRINT  •■ 

M4 
LOCATE  23,30:PRINT"*"bank:RETURN4 
ChkFDTP:4 
FOR  Q-l  TO  SU4 

IF  RIGHT* (FD*(Q,F(Q)),1) -RIGHT* (tp*,l)  THEN  F*-FD*(Q 
,F(Q)):s=Q4 

NEXT: IF  »<>0  THEN  IsAce  ELSE  RETURN4 
I s Ace: 4 

IF  LEFT*(F*,1>«"A"  THEN  v-1: GOSUB  VaLC:GOTO  VC4 
GOSUB  VaLG: GOSUB  VaLC4 
VC:4 

IF   v+lOc    THEN   RETURN4 
F (s) -F (») +1 : FD* (s, F (m) ) »tp*: xL«2: yL»3+  <4*s) : HIT-14 
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GOSUB  ShowCard:GOSUB  VBan k : RETURN4 

LTaLon:4 

xL«21:yL-19:TN»TN-l: GOSUB  DPack:GOTO  PBLank4 

ChkTable:4 

IF  ASC (RIGHT* (tp*, 1))<»66  AND  ASC (RIGHT* (TB* (r, y) , 1 ) 

X-66  THEN  RETURN* 

IF  ASC (RIGHT* (tp*, 1))«>67  AND  ASC (RIGHT* (TB* (r, y) , 1 ) 

)->67  THEN  RETURN* 

F*«TB*(r,y)4 

IF  LEFT*(tp*f  1)«"A"  THEN  c«l:GOSUB  VaLG  ELSE  GOSUB  V 

aLGs GOSUB  VaLC4 

IF   v-lOc    THEN   RETURN4 

t  <r )  =t  (r )  +1 : xL=6+ ( t (r ) -1 ) : yL*5> (4*r ) 4 

TB* (r , y+1 ) =tp*: HIT«1 : RETURN* 

TnMiN:4 

GOSUB  ShowCard: TN=TN-1 : tp*«pk* (TN) 4 

xl_=21:yL- 19:  GOSUB  ShowCard: GOSUB  DPack:HIT=0:GOTO  PB 

Lank4 

4 
4 
endgame: 4 

CLS:LOCATE  10,8:PRINT"You  have  *"bank"  remaining- "4 
LOCATE  12,5:PRINT"Thank  you  for  playing  ";:COLOR  6:P 
RINT"CANFIELD"4 
OPEN  NAM*  FOR  OUTPUT  AS  #14 
PRINT#l,bank4 
CLOSE  14 

WINDOW  CLOSE  3: SCREEN  CLOSE  1:END4 
StackPLay:4 
IF  ST-0  THEN  RETURN4 
tp*-ST*(ST)4 
GOSUB  GetKey4 

IF  a*-"F"  THEN  GOSUB  ChkFDTP: GOSUB  NewStock:RETURN4 
IF  a*>-"lH  AND  a*<«,,4"  THEN  r=VAL  (a*)  :y«t  (r)  :  GOSUB  C 
hkTable: GOSUB  NewStock:RETURN4 
RETURN4 
NewStock:4 

IF  HIT«0  THEN  RETURN4 
GOSUB  ShowCard: ST«ST-1 : tp*«ST* (ST) 4 
xL«10:yL«2: GOSUB  ShowCard: HI T=04 
IF  ST»0  THEN  COLOR  0,2: GOSUB  ShowCard :RETURN4 
ReChK:4 

IF  LEFT*(ST*(ST),l)OLEFT*(FD*(l,l),l>  THEN  RETURN4 
GOSUB  DeLaY:SU*SU+l:FD*(SU,l)»ST*( ST): GOSUB  NewSuit4 
GOSUB  DeLaY : i  «SU : F-F+4 : t p*»ST* ( ST ) 4 
xL»2:yL=F: GOSUB  ShowCard : GOSUB  VBank: ST-ST-14 
tp*=ST* (ST) :xL=10:yL=2: GOSUB  ShowCard: GOTO  ReChK4 
4 

TtoTA:4 

a=VAL (a*) : GOSUB  GetKey : b*=a*: b=VAL (a*) 4 
LOCATE  23, 9: PRINT  b*: t»t (a) : s-a4 
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IF   a>-l    AND   a<=4    THEN   tp*-TB* (a, t) 4 

IF   b$<>"F"    THEN   AeB4 

IF    LEFT*(tp*,l)OLEFT*(FD*(l,l),l>    THEN    NoM4 

IF  SU<4  THEN  SU-SU+1  ELSE  NoM4 

F (SU) =1 : FD* (SU, 1 ) =tp*4 

NoM:4 

60SUB  ChkFDTP4 

IF  HITOl  THEN  RETURN4 

HIT-04 

IF  a>=l  AND  a<=4  THEN  t (a) =t (a) -1 : IF  t(a)=0  THEN  NoT 

A4 

tp*="   ":xL»6+t(a):yL=5+(a*4):G0SUB  ShowCard4 

tp*=TB* (a, t (a) ) : xL=6+ (t (a) -1 ) : GOSUB  ShowCard : RETURN4 

NoTA:4 

tp*="   M:xL=6+t(a>:yL=5+(a*4) : GOSUB  ShowCard4 

IF  STO0  THEN  t=a:  GOSUB  STK:  t  (a)  =1 :  RETURN4 

AeB:4 

IF  a=b  THEN  RETURN4 

IF  b>=l  AND  b<=4  THEN  F*=TB* (b, t (b) > : GOTO  PLyTabLe4 

RETURN4 

PLyTabLe:4 

IF  a>=l  AND  a<=»4  THEN  tp*=TB* (a, 1 > 4 

IF  t(b)=0  THEN  v-l:c=0:GOTO  cv<: 

IF  ASC(RIGHT*(tp*,l>><=66  AND  ASC (RIGHT* (F*, 1 ) )<=66 

THEN  RETURN4 

IF  ASC (RIGHT* (tp*, 1) )=>67  AND  ASC (RIGHT* (F*, 1 )) =>67 

THEN  RETURN4 

IF  LEFT*(tp*,l)="A"  THEN  c-1: GOSUB  VaLGrGOTO  cv4 

GOSUB  VaLC: GOSUB  VaLG4 

cv:4 

IF    v-lOc    THEN    RETURN4 

IF   a>=l    AND   a<=4    THEN    yL=5+a*4: t (a) =04 

tp*»"       "4 

FOR  y=t  TO  0  STEP-l:xL=7+(y-l>: GOSUB  ShowCard: NEXT4 

yL=5+ (b*4> : TA=b: sb=t (b ) 4 

4 

FOR  ty=l  TO  t4 

TB* (TA, sb+ty >  =TB* (s, ty) :  t  (b )  =t  (b ) +14 

tp*=TB* (s, ty ) : xL=5+ (sb+ty) 4 

GOSUB  ShowCard4 

NEXT  ty4 

4 

IF  t(a)=0  AND  STO0  THEN  NoTA4 

RETURN4 

4 

NewSuit : 4 

F(SU)=1:RETURN4 

VaLG:4 

g*=F*: GOSUB  Vcards: v=g: RETURN4 

VaLC: 4 

g*-tp*: GOSUB  Vcards:c-g: RETURN4 
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Vcard*:4 

FOR  i  =  13  TO  1  STEP-1:IF  LEFT* <g*, 1 ) =v*(i )  THEN  g»i  +  l 

4 

1520  NEXT:RETURN4 

'4 

InitShapes:4 

RESTORE  InitShapes4 

FOR  j=0  TO  3: FOR  i=0  TO  36:4 

READ  a*:sb(i,  j)-VAL(,,««H,,+a*)  :NEXT  i,j4 

RETURN4 

4 

'heart4 

DATA  8,8,4, FF00 , FF00 , FF00 , FF00 , FF004 

DATA  FF00 , FF00 , FF00 , FF00 , 9900 , 8 1 00 , 8 1 00 , 8 1 004 

DATA  C300 , E700 , FF00 , FF00 , 9900 , 8 1 00 , 8 1 00 , 8 1 004 

DATA  C300 , E700 , FF00 , 0 , 6600 , 7E00 , 7E00 , 7E004 

DATA  3000,1800,0,0,04 

4 

'diamond 4 

DATA  8,8,4, FF00 , FF00 , FF00 , FF00 , FF004 

DATA  FF00 , FF00 , FF00 , FF00 , E700 , C300 , 8 1 00 , 8 1 004 

DATA  C300 , E700 , FF00 , FF00 , E700 , C300 , 8 1 00 , 8 1 004 

DATA  C300 , E700 , FF00 ,0,1 800 , 3C00 , 7E00 , 7E004 

DATA  3000,1800,0,0,04 

4 

*club4 

DATA  8,8,4, FF00 , E700 , E700 , 9900 , 99004 

DATA  E700 , 0300 , FF00 , FF00 , E700 , E700 , 9900 , 99004 

DATA  E700 , 0300 , FF00 , FF00  f  E700 , E700 , 9900 , 99004 

DATA  E700 , 0300 , FF00 ,0,1 800 , 1 800 , 6600 ,  66004 

DATA  1800,3000,0,0,04 

4 

4 

' spade4 

DATA  8,8, 4, FF00, E700, 0300, 8100, 81004 

DATA  8 1 00 , E700 , FF00 , FF00 , E700 , 0300 , 8 1 00 , 8 1 004 

DATA  8100, E700 , FF00 , FF00 , E700 , 0300 , 8 1 00 , 8 1 004 

DATA  8100, E700 , FF00 ,0,1 800 , 3000 , 7E00 , 7E004 

DATA  7E00,1800,0,0,04 

4 

4 

Get Key: 4 

a*=INKEY*4 

IF  a*<>,,n  THEN4 

a*-UCASE*(a«>4 

key»ASC(a*>4 

ELSE4 

GOTO  GetKey4 

END  IF4 

RETURN4 

4 
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ShowDeck:4 

LOCATE  20,11:COLOR  2, 10: PRINT  pk4 

IF  pk»0  THEN4 

COLOR  10, 104 

ELSE4 

COLOR  15, 154 

END  IF4 

tp*="   ": LOCATE  21, 12: PRINT  tp*4 

LOCATE  22, 12: PRINT  tp*4 

RETURN4 

4 

DoScreen:4 

SCREEN  1,320,200,4, 1: WINDOW  3, " M , (0, 0) - (31 1 , 186) , 16, 

1:4 

WINDOW  OUTPUT  3: COLOR  3,0: WIDTH  40: RESTORE  PaLetteDa 

ta:FOR  i«0  TO  154 

READ  r,g,b: PALETTE  i , r, g, b: NEXT4 

RETURN4 

4 

PaLetteData:4 

DATA  0, .7,04 

DATA  0,0,04 

DATA  1,1,14 

DATA  1,0,04 

DATA  1,1,14 

DATA  0,0,04 

DATA  1,0,04 

DATA  1, 1, 14 

DATA  0,0,04 

DATA  1,0,04 

DATA  0,-7,04 

DATA  1,0,04 

DATA  1,0,04 

DATA  1, .5,-14 

DATA  1, .7, .14 

DATA  1,-6,. 14 


4 
4 
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Monte  Carlo 

Thomas  Carlson 
Translation  by  Bill  Chin 


Casino  excitement  at  home  can  be  yours  when  you 

type  in  this  soiitaire  card  game.  In  this  recreation  of 

the  classic  millionaire's  gambit,  choose  pairs  of  cards 

and  heat  the  odds.  Type  in  the  accompanying  listing 

and  save  a  copy  be/ore  you  run  it. 


Monte  Carlo  is  the  name  of  a  town  in  Monaco  that  is  famous 
as  a  gambling  resort.  It  also  gave  birth  to  the  name  of  a  card 
game  with  simple  rules  and  complex  strategies. 

To  play  "Monte  Carlo/7  shuffle  a  deck  of  cards  and  deal 
20  cards  into  a  grid  5  cards  across  by  4  cards  down.  The  goal 
of  the  game  is  to  remove  all  the  cards  from  the  grid.  Cards  can 
be  removed  only  in  pairs.  The  cards  must  be  of  the  same  face 
value  for  you  to  remove  them.  In  addition,  they  must  be  adja- 
cent vertically,  horizontally,  or  diagonally.  The  remaining 
cards  slide  to  the  left  to  fill  in  the  gaps.  Gaps  at  the  right  edge 
are  filled  in  by  moving  cards  up  from  the  row  below.  When  all 
the  cards  have  been  moved,  two  cards  from  the  deck  are  dealt 
into  the  empty  slots  at  the  bottom  right  corner  of  the  board. 
Eventually,  all  cards  in  the  deck  are  exhausted.  You  win  the 
game  if  you're  able  to  remove  the  remaining  cards  from  the 
board. 

As  you  can  imagine,  all  this  moving  about  of  cards  can 
take  quite  a  long  time  if  you're  playing  with  a  real  deck  of 
cards.  Letting  the  computer  do  the  busy  work  makes  the  game 
more  enjoyable.  As  you  play,  youTl  develop  strategies.  Each 
pair  you  remove  can  destroy  other  pairs  on  the  board  and  cre- 
ate new  ones.  But  you  might  also  have  fun  just  removing  the 
first  pair  of  cards  that  you  see.  This  game  can  be  played  by 
those  who  would  rather  leave  their  fate  to  the  wind,  those 
who  analyze  the  consequences  of  each  and  every  move,  and 
all  those  players  in  between.  Three  difficulty  levels  are  in- 
cluded. The  level  affects  the  number  of  rows  on  the  the  grid. 
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Easy  is  six  rows,  Medium  is  five,  and  Hard  is  four.  Choose  the 
difficulty  at  the  beginning  of  the  game. 

Monte  Carlo  uses  the  mouse  to  select  cards.  To  choose  a 
card,  move  the  mouse  pointer  to  the  first  card  and  click  the 
left  mouse  button.  Then  move  the  pointer  to  the  other  card 
and  click  again.  The  cards  are  removed  and  the  other  cards 
slide  into  place.  If  you  wish  to  deselect  a  card,  point  to  the  se- 
lected card  and  click  on  it  again.  Press  Q  at  any  time  for  a 
new  game. 

When  you've  selected  a  card,  move  to  the  matching  card 
(remember,  the  two  cards  you  wish  to  remove  must  have 
either  a  corner  or  an  edge  in  common)  and  press  RETURN 
again.  The  computer  will  not  let  you  make  an  illegal  move. 

Monte  Carlo 

Filename:  MONTE  CARLO 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

*  Copyright  1987  COMPUTE!  Publication*,  Inc.   All  ri 

ghts  rmmmrvwd.< 

GOSUB  Defin»PLayFi*Ld4 

start: 4 

DEFINT  a-z4 

CLS sPRINT    ••    Copyright    1987   COMPUTE!    Publications"sP 
RINT   TABU0)"A11    rights  rtitrvtd.N4 

LOCATE  4, 14 sPRINT  "MONTE  CARLO"! PRINT* 

DIM   c*<52),v*<13),t*<4),c2<32>4 

c*<52>="  -"4 

RESTORE: FOR  i«l  TO  134 

READ  a*sv*<i)«a*sNEXT4 

DATA  "  A","  2","  3","  4","  5","  6","  7","  8","  9"," 
10","  J","  Q","  K"4 

PRINT  TAB<12)$ "Shuffling  Dsck"4 

RANDOMIZE  TIMER4 

FOR  i  =  l  TO  4s FOR  j-1  TO  134 

p=INT<RND<l>*52>4 
skip2s  IF  c*<p)=""  THEN  c*<p)»v*< j) sc2<p)«<i-l) *43tG 
OTO  skipl4 

p=p+l:IF  p=52  THEN  p»04 

GOTO  skip2:4 
ski  pis  NEXT:NEXT4 

GOSUB  suit shapes* 

SOUND  440,1.54 

PRINT: PRINT4 

PRINT  TAB < 14) "Click  on:"sPRINT4 

PRINT  TAB<16)"HARD"4 
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PRINT  TAB < 16) "MEDIUM"* 

PRINT  TAB < 16) "EASY"* 
skip4s  WHILE  MOUSE (0)»0iWEND* 

x  =MOUSE (1)1 y -MOUSE (2)4 

IF  x<120  OR  x>170  OR  y<80  OR  y>103  THEN  skip4* 

IF  y<104  THEN  c=6* 

IF  y<96  THEN  c«5* 

IF  y<88  THEN  c=4* 

WH I LE  MOUSE ( 0 ) <>0 s WEND* 
displays* 

ct=0:CLSs LOCATE  5,1* 
FOR  i  =  l  TO  c:t»4* 

FOR  j=l  TO  5* 
PRINT  SPC(t);c*(ct) jst»5* 

IF  c*(ct)<>"  -"  THEN  PUT  <  j*56-6, i*24+8)  f  suit  (c2(c 
t))* 

ct  =  ct«-l* 

NEXT* 

PRINT: PRINT: PRINT  * 
NEXT* 
PRINT  TAB<12) ; "EXIT";SPC(8) ; "RESTART"!* 

IF  c*(0)="  -"  THEN  LOCATE  2, 12:PRINT"Tableau  is  cle 
ared":60T0  winner* 

x=0:y=0* 

cr*=CHR*(62) :60SUB  cursor :xl»xiyl-y8pl«y*5+XB SOUND 
440,1.5* 

cr*=CHR*(187)  sGOSUB  cursor sx2=x:y2«yip2«y*5+x* 

IF  pl=p2  THEN  display* 

IF  (LEFT*(c*(pl),2)XXLEFT*<c*(p2),2)>  THEN  invaLi 
d* 

IF  ABS(x2-xl)>l  OR  ABS(y2-yl)>l  THEN  invaLid* 

SOUND  660,1.2* 

FOR  i=pl  TO  51* 

c*  ( i  ) =c*  <  i  +1 ) i c2  <  i  > -c2  C i  +1 > i NEXT* 

IF  p2>pl  THEN  p2=p2-l* 

FOR  i=p2  TO  51* 

c*(i)=c*(i+l):c2(i)=c2(i+l):NEXT* 

GOTO  display* 
winner:  * 

FOR  i  =  l  TO  11* 

SOUND  440,1: SOUND  660, 1 : a*=INKEYS* 

NEXT:game=l* 

GOSUB  cursor* 
invaLid:* 

SOUND  150, 3: GOTO  display* 
cursor: 4 

WHILE  MOUSE (0)=0: WEND* 

>;>;=  (MOUSE  <  1 )  -12)  /8:  yy=  (MOUSE  <2)  -36)  / 12* 

>;=(>: >i -6) /7:y=yy/2* 

IF  yOc  OR  (yy  MOD  2)=1  THEN  skip3* 
IF  >;><>?  AND  xx<14  THEN  CLS:END* 


91 


CHAPTER  TWO 


IF  >;>;>20  AND  >ix<29  THEN  CLEAR  ,,25000: GOTO  start* 

SOUND  190,1.9:GQTO  cursor  4 
skip3:  4 

IF  game  THEN  SOUND  190,1.9:GOTO  cursor  4 

IF  <>;>;  MOD  7X3  OR  (yy  MOD  2)<>0  THEN  SOUND  190,1.9 
:GOTO  cursor 4 

>;=  Cx>;-6)  /7:y=yy/24 

IF  x>4  OR  x<0  OR  y<0  OR  y>*c  THEN  SOUND  190,1.9:GOTQ 
cursor4 

t>;  =>;  *56+30:  ty=y*24+30:  LINE  <tx  ,  ty )  -  <tx+40,  ty«-10)  ,  3, 
b  4 

WHILE  MOUSE(0)O0:WEND4 

RETURN4 

Def  i  nePLayFi  eLd : 4 
SCREEN  1,320,200,2,14 
WINDOW  l,"MONTE  CARLO", ,2, 14 
PALETTE   0,-5,-5,-94 
F ALETTE   1,0,0,04 
TALETTE   2,1,0,04 
T ALETTE   3,-9,-9,04 

RETURN4 
sui tshapes: 4 

DIM  suit (299): RESTORE  suitshap»s4 

m~  42  ;n»2=  10  :  GOSUB  ReadCompressed4 

DATA   9,  7,  2,  6144,  15360,  32256,-256,-256  4 

DATA   6144,  15360,  40033  4 

m»  42  :m2=  10  i GOSUB  Read Compressed 4 

DATA   8,  7,  2,  0,  6144,  6144,  32256,  26112  4 

DATA   6144,  15360,  40033  4 

m*  42  !m2»  11  s GOSUB  RsadComprssssd4 

DATA   8,  7,  2,  40007,  2048,  7168,  15872,  32512  4 

DATA   15872,  7168,  2048,  40026  4 

m=  42  :m2=  11  : GOSUB  ReadCompressed4 

DATA   8,  7,  2,  40007,  27648,-512,-512,-512  4 

DATA   31744,  14336,  4096,  40026  4 
RETURN4 
ReadCompressed: 4 

FOR  j=0  TO  m24 

READ  t&  4 

IF  t&<40000&   THEN   suit  <i2)=t8t:  i2«i 2+1    ELSE   FOR   i-0 
TO   t&-40000St:suit<i+i2)=0:NEXT:i2»i2+tSc-40000Sc4 

NEXT   4 
RETURN4 
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Action  Arcade 
Games 


Climber  5 

James  Rogers 
Translation  by  Bill  Chin 


This  fast-moving  arcade  game  is  brilliantly  con- 
ceived. As  a  construction  worker  at  a  building  behind 
the  ballpark,  you  want  to  retrieve  home-run  balls  hit 
by  your  favorite  all-stars.  Time  is  of  the  essence,  but 
you  must  avoid  moving  hooks  of  various  sizes.  This 
keyboard-controlled,  one-player  game  requires  at 
least  512K  of  memory. 


"Play  ball,"  the  umpire  cries,  and  the  game  begins.  As  a  con- 
struction worker  at  the  site  of  a  new  building  behind  the 
ballpark,  your  task  seems  simple:  Retrieve  stray  balls  and  add 
them  to  your  collection.  The  number  5  on  the  back  of  your 
working  uniform  shows  that  at  heart  you're  part  of  the  team. 
When  a  ball  flies  out  of  the  park  onto  the  building,  the  game 
grinds  to  a  halt  while  a  stadium  full  of  fans  and  players  cheers 
your  valiant  effort  to  get  it  down. 

You're  used  to  the  pressure,  but  that  doesn't  make  the 
waiting  any  easier.  The  first  inning  passes,  followed  by  the 
second  and  third,  without  any  problem.  Then,  at  the  top  of 
the  fourth  inning,  the  first  batter  swats  a  towering  homer  over 
the  left-field  wall.  Up,  up  it  goes,  so  high  that  you  grab  your 
field  glasses  to  track  it.  Yes,  it's  outside  the  stadium.  It  looks 
like  the  ball  lodged  right  at  the  top  of  the  building,  which  is 
still  under  construction.  As  you  rush  to  retrieve  the  prize, 
you'll  have  to  duck  and  dodge  to  avoid  obstacles  on  the  con- 
struction site. 

About  the  Program 

The  listing  that  accompanies  this  article  is  ready  to  type  in.  Be 
sure  to  save  a  copy  before  you  run  it.  The  shapes  for  the  ani- 
mated climber  and  moving  hooks  were  first  drawn  with  De- 
luxe Paint  and  then  were  converted  for  BASIC  with  the  "IFF 
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Translator"  program  also  included  in  this  book.  A  simple  com- 
pression algorithm  is  used  to  reduce  the  amount  of  shape  data 
you  need  to  type  in.  The  subroutine  ReadCompressed  handles 
data  for  one  shape  each  time  it  is  called.  Data  elements  with  a 
value  less  than  40000  are  stored  directly  in  the  shape  array. 
Any  number  greater  than  40000  represents  a  group  of  zero 
values.  The  routine  subtracts  40000  from  the  value  to  deter- 
mine how  many  zeros  to  place  in  the  array.  For  instance,  the 
number  40015  means  that  we  need  to  put  15  zeros  in  the  ar- 
ray. The  number  40000  is  used  because  a  normal  shape  data 
value  would  never  be  greater  than  32768.  One  reason  the 
shape  data  contains  many  zeros  is  that  not  all  the  colors  are 
used  in  every  shape. 

Playing  the  Game 

The  Climber  5  screen  consists  of  several  horizontal  levels. 
When  the  game  begins,  you  are  at  the  bottom  right  corner  of 
the  screen,  and  the  ball  is  at  the  upper  left.  Your  job  is  to 
climb  and  run  to  where  the  ball  lies,  avoiding  the  moving 
hooks  along  the  way.  Since  some  of  the  hook  objects  are 
speedy  indeed,  that's  more  difficult  than  you  might  imagine  at 
first.  You  can  move  left  or  right  with  cursor  controls.  There  are 
short  and  long  hooks.  The  long  hooks  must  be  avoided  by 
running  to  a  different  place  on  the  construction  frame.  The 
short  hooks  may  be  evaded  by  ducking  down  (press  the  down 
cursor  key  to  duck). 

Each  level  is  connected  to  the  next  by  one  or  more  lad- 
ders. The  cursor  controls  allow  you  to  move  up  or  down  a  lad- 
der; of  course,  you  must  be  perfectly  aligned  with  the  ladder 
in  order  to  ascend  or  descend  on  it. 

You  have  a  total  of  five  players  when  the  game  begins. 
Whenever  you  get  "hooked"  (hit  by  a  moving  hook),  you  lose 
one  player.  That  really  hurts.  You  can  enjoy  the  Amiga  speech 
emulator  as  it  reports  your  demise  with  an  ungrateful 
"OUCH!"  The  game  ends  when  you  have  lost  all  your  play- 
ers. If  you  reach  the  ball  without  being  hit,  the  program  dis- 
plays a  congratulatory  message  and  lets  you  try  the  next  skill 
level,  where  everything  becomes  more  difficult. 
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Climber  5 

Filename:  CLIMBER5 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

»   Copyright  1987  COMPUTE!  Publication*,  Inc. 4 
*   All  Rights  Reserved 4 

4 

'Climber  54 

'Copyright  19874 

'Compute!  Publications,  Inc. 4 

'All  Rights  Reserved. 4 

DEFINT  a-z4 

men=5:SAY  TRANSLATE* ( "cl i mer  five!") 4 

DIM  map (45, 24) ,mdat (100) ,chk&(7),ex (4) , ey (4) , ty (4) , o 

Id (2) , mindex (4) :endmap=1004 

GOSUB  Def inePLayFieLd4 

RESTORE  mapdata: t=l:cm=14 

WHILE  t<>-14 

READ  t:mdat(c)=t  :c=c+14 

IF  t=0  THEN  mindex (cm) =c: cm=cm+14 

WEND4 
4 

mapdata:4 

DATA  1,6,  1,12,  1,18,  2,2,  2,9,  2,15,  3,6,  3,12,  3,1 
8,  4,2,  4,9,  4,15,  04 

DATA  1,3,  1,16,  2,5,  2,15,  3,9,  3,11,  4,7,  4,14,  0 
4 

DATA  1,9,  2,3,  2,13,  3,7,  3,17,  4,14,  04 
DATA  1,7,  2,17,  3,3,  3,10,  4,15,  04 
DATA  1,10,  2,4,  3,13,  4,9,  -14 

4 
stand»0:cl=  867: rt 1-313: rt2«420:duck=103: baLL=654:gi 
rd=603: hook=6854 

c2=974: Lt 1=1081 : Lt2=l 188: shorthook-13714 
GOSUB  makeshapes:4 
NewBoard: 4 

GOSUB  MakeMap:px«266:py«13B:psn«3134 
PUT  (px ,py) , shape (psn) :cf «04 
FOR  i=0  TO  4:ex(i)»320:NEXT4 

WHILE  vnext-04 
'keyboard  input4 

kf =33: dx=0: dy=0: a=04 
WHILE  dx=0  AND  dy=0  AND  kf>04 

a*=INKEY*:a=ASC(a*+H  ")4 

IF  a=29  THEN  dy=8:G0T0  keypressed4 

IF  a=28  THEN  dy— 8: GOTO  keypressed4 

IF  a=31  THEN  dx=-8:80T0  keypressed4 

IF  a=30  THEN  dx=84 

kf=kf-14 
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keypressed: 4 
MEND  4 

BOSUB  pLayer4 
'hooks4 
FOR  n  -  0  TO  4  4 

IF  ex(n)<318  THEN  onscreen^ 

PUT(ex (n) ,ey(n) ) , shape (hook) , X0R4 

t!=RND(l):IF  t!>.3  THEN  eskip4 

IF   t!>.2  THEN  esn(n)=hook  ELSE  esn (n) «shorthook4 

ex (n ) =0: ty (n) =n*4+l : ey (n ) =n*32+94 

PUT  (ex (n) ,ey(n) ) , shape (esn (n) ) , X0R4 
onscreen: 4 

th*esn(n)  4 

PUT  (ex(n),ey(n)),shape(th),X0R4 

ex  (n)  «  ex  (n)+164 

PUT  (ex (n),ey(n)), shape (th),X0R4 

tx«ex (n) /8: ty^ty (n) 4 

IF  th«hook  AND  (  map  (tx-1 ,  ty+1 )  =2  OR  map  (tx  ,  ty+1 )  ■ 
2  OR  map(tx-2,ty+l)=2  )  THEN  GOSUB  kiLLed4 

IF  map (tx-1, ty) =2  OR  map(tx,ty)=2  OR  map (tx-2, ty) ■ 
2  THEN  GOSUB  kiLLed4 
eskip:  4 
NEXT4 
WEND4 

t*=uI  got  the  ball": IF  building>0  THEN  t*=t*+"  agai 
n."4 
IF  building=4  THEN  t*="I  am  getting  tired. "4 
IF  vnext=2  THEN  SAY  TRANSLATE* (t*) 4 
vnext=04 

IF  men>0  THEN  NextMap4 
SAY  TRANSLATE* ( "game  over . " ) 4 
LOCATE  1,1:  PRINT  "  (C)ontinue  ":  PRINT  "  (R)estart 

":PRINT  "  (Q)uit  "4 
men=54 

Loopg:  a*=INKEY*: IF  a*="r"  THEN  bui lding=0: GOTO  New 
Board4 
IF  a*="c"  THEN  GOTO  NewBoard4 
IF  a$="q"  THEN  CLS: CLEAR: ST0P4 
GOTO  Loopg4 
Next Map: 4 
building=(building+l)  MOD  5  4 
GOTO  NewBoard4 
kiLLed:4 
SAY  TRANSLATE* ( "ouch . " ) 4 
PUT  (px,py) , shape (psn) , X0R4 

FOR  i=0  TO  2:map  (mx , my+i-2) =old (i ): old (i ) =0: NEXT 
4 
PUT  (ex (4) , ey (4) ) , shape (esn (4) ) , X0R4 
px=266:py=1384 
ex (4)=318:psn=stand:cf =04 
PUT  (px , py) , shape (psn) : men=men-14 
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IF  men=<0  THEN  vnext=l :men=04 

LOCATE  23,8:PRINT  "  Climbers  ";men;M  Level  M;buildi 
ng+l;4 

RETURN* 
4 
pLayer: 4 

WH I LE  I NKEY«<  > " " : WEND4 

mx=px/8:my= (py+17) /84 

map  (mx , my-2)=old (0) 4 

map  (mXjmy-D^old  (1)4 

map  (mx, my) =old (2)  4 

IF  dy  AND  cf«0  THEN  GOSUB  trycLimb4 

ON  c-f  GOTO  cLimbing, ducking  4 

IF  dx  THEN  movepLay4 

sf=s-f  +  l:REM  standing  on  girder4 

IF  s-f>2  THEN  PUT  (px , py) , shape (psn) , XOR: PUT  (px,py) 
, shape (stand) : sf =1: psn=stand4 

GOTO  oLdmap4 
4 
trycLimb:4 

t»my: IF  dy>0  THEN  t»my+14 

IF  map(mx,t)=l  THEN  c-f  =  1:RETURN4 

IF  dy>0  THEN  PUT  (px , py) , shape (psn) , XUR: PUT  <px,py) 
,  shape  (duck) :  psn=duck:  c-f  =24 

RETURN4 
4 
movepLay:4 

sf=0  :pb=rtl:IF  dx<0  THEN  pb=Ltl4 

tx=px+dx  :ty=py4 

IF  tx<8  OR  tx>300  THEN  tx«px4 

IF  tx=10  AND  ty=10  THEN  f r=l : pb=duck : vnext=24 

GOTO  animate* 

4 
ducking: 4 

IF  dx  OR  dy<0  THEN  c-f  =0:  psn=duck:  RETURN4 

GOSUB  oLdmap  4 

map  (mx  ,  my-2)  =04 

RETURN4 
4 
cLimbing: 4 

IF  dy=0  THEN  oLdmap4 

pb=cl: tx=px: ty»py+dy: tmy=(ty+17) /B  4 

IF  (tmy  AND  3)  =3  THEN  c-f  =0:  pb=stand:  f  r=l  4 

GOTO  animate4 
4 
animate: 4 

PUT  (px,py) , shape (psn) , X0R4 

•fr=l— fr:psn=pb+fr*1074 

PUT  (tx, ty) , shape (psn) 4 

px=tx : py=ty: mx=px/8: my= (py+17) /84 
oLdmap:  4 
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ol d ( 0 ) =map ( mx , my-2 ) : map ( mx , my-2 ) =24 
ol d ( 1 ) =map ( mx , my- 1 ) : map ( mx , my- 1 ) =24 
ol d ( 2 ) =map ( mx , my ) : map ( mx , my ) =24 
RETURN  4 
4 
MakeMap:4 
FOR  i=  0  TO  39: FOR  j=0  TO  244 

map ( i , j ) =0: NEXT: NEXT4 
c  =  mi ndex (building) :CLS  :yc=04 
FOR  y=yc  TO  yc+180  STEP  32: FOR  x=0  TO  319  STEP  84 

PUT  (x,y) ,shape(gird) :NEXT:NEXT4 
WHILE  mdat(c)>04 
y2=mdat  <c ) : x2=mdat  <c+l ) «2: my=y2*44 
FOR  j=my  TO  my+3: map (x2, j ) =1: NEXT  4 
tx»x2*8:ty=y2*32-54 
LINE  (tx,ty)-(tx  +  16,ty+36),0,b-f4 
LINE  <tx,ty)-(tx+2,ty+36)  ,8,b-f4 
LINE  <tx+14,ty)-(tx+16,ty+36)  ,8,b-f4 
FOR  j=ty+4  TO  ty+28  STEP  84 
LINE  (tx+2, j)-(tx+14, j) ,8,b:NEXT  j4 
temp:  4 
c=c+24 
WEND4 

PUT  (20, 28) , shape (baLL) : map (0, 0) =-1   4 
LOCATE  23,8:PRINT  "  Climbers  ";men;"  Level  ";build 
ing+1;  4 

RETURN  4 
makeshapes: 4 

i2=0  : RESTORE  makeshapes: CLS4 

LOCATE  10, 2: PRINT  "Copyright  1987  Compute!  Publicati 
ons"4 

LOCATE  12, 10: PRINT  "All  rights  reserved."  4 
FOR  i=0  TO  7: READ  chk& (i ) :NEXT4 
9    checksums4 

DATA  445496,  818859,  13938514 
DATA  1902864,  2002109,  21009104 
DATA  2406221,  2606260  4 
DIM  shape (1599) 4 
'shape  0   man  standing  still4 
m=  102  :m2=  58:G0SUB  ReadCompressed4 

DATA  14  ,  22  ,  4  ,  40002  ,  256  ,  896  ,  1408  ,  3968  4 
DATA  1792  ,  8160  ,  16368  ,  30664  ,-4124  ,  32756  ,  15 
736  ,  8176  4 
DATA  3040  ,  2400  ,  736  ,  2240  ,  2784  ,  3808  ,  7920  , 

15480  4 
DATA  40002  ,  768  ,  3968  ,  1280  ,  3840  ,  768  ,  3840  , 

8160  4 
DATA  16368  ,  30680  ,  14296  ,  6832  ,  2080  ,  1024  ,  16 
64  ,  3072  4 
DATA  1568  ,  1024  ,  40007  ,  1280  ,  3840  ,  768  ,  1536 


,  0  4 
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DATA  2080  ,  4112  ,  0  ,  2720  ,  4064  ,  1728  ,  1728 

136   4 

A00Z7    4 


DATA  14 
DATA  896  , 
76  ,  8176  4 
DATA  7280 


,    1920   4 

DATA  128  ,  896  ,  8176  ,  5008  ,  4368  ,  12312  ,  4112 

40013  4 
DATA  640  ,  1920  ,  128  ,  896  ,  256  ,  0  ,  3104  ,  1521 

4 


DATA  6448  ,  2080  ,  2080  ,  40036  4 

'shape  2   ducking4 

m-  106  :m2=  56:60SUB  ReadCompressed4 

DATA  14  ,  23  ,  4  ,  40003  ,  8192  ,  29440  ,  30592  ,  22 

400  4 

DATA  29440  ,  27872  ,  24720  ,  13640  ,  6728  ,  3832  ,  3 

432  ,  7664  4 

DATA  7024  ,  5808  ,  4848  ,  6896  ,  7920  ,  7920  ,  7776 

,  3072  4 

DATA  40004  ,  8960  ,  1920  ,  8192  ,  8960  ,  13056  ,  163 

52  ,  8176  4 

DATA  2032  ,  2032  ,  656  ,  528  ,  1152  ,  2112  ,  3072  , 

1024  4 

DATA  40008  ,  8192  ,  40002  ,  768  ,  4864  ,  0  ,  2048  , 

1056  4 

DATA  0  ,  640  ,  4080  ,  3296  ,  3168  ,  3104  ,  3168  ,  30 

72  4 

DATA  40038  4 

'shape  3  run  right4 

m~  106  :m2=  63:G0SUB  ReadCompressed4 

DATA  13  ,  23  ,  4  ,  0  ,  512  ,  3328  ,  8064  ,  7424  4 

DATA  8064  ,  3856  ,  5688  ,  14200  ,  25584  ,-8288  ,  327 

04  ,  16128  4 

DATA  7936  ,  8064  ,  6080  ,  9184  ,  19952  ,  23008  ,-277 

12  ,-2176  4 

DATA  29568  ,  14816  ,  0  ,  1536  ,  3840  ,  8128  ,  1280  , 

1920  4 
DATA  3584  ,  1552  ,  7728  ,  16224  ,  28480  ,  14080  ,  66 
56  ,  3072  4 

DATA  0  ,  2048  ,  7168  ,  12288  ,  8192  ,  24576  ,  40007 
,  1280  4 

DATA  1920  ,  3584  ,  1552  ,  16  ,  0  ,  64  ,  0  ,  2048  4 
DATA  3072  ,  768  ,  2944  ,  7616  ,  12384  ,  8384  ,  24960 

,  40038  4 


,  40038  4 

'shape  4   running  right  second  frame4 
m=  182  :m2=  95:G0SUB  ReadCompressed4 
DATA  25  ,  20  ,  4  ,  40002  ,  32  ,  0  ,  112  ,  0  4 
DATA  254  ,  0  ,  232  ,  0  ,  252  ,  0  ,  120  ,  0  4 
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DATA  240  ,  0  ,  944  ,  0  ,  1919  ,-32768  ,  3519  ,-16384 

4 
DATA  4031  ,-32768  ,  2040  ,  0  ,  1023  ,  0  ,  383  ,-1638 
4  4 

DATA  15871  ,-16384  ,  32739  ,-8192  ,-64  ,-512  ,-6208 
,  32256  4 

DATA  384  ,  28672  ,  40002  ,  48  ,  0  ,  120  ,  0  ,  254  4 
DATA  0  ,  40  ,  0  ,  60  ,  0  ,  112  ,  0  ,  112  4 
DATA  0  ,  224  ,  0  ,  688  ,  0  ,  1759  ,-32768  ,  608  4 
DATA  0  ,  768  ,  40003  ,  128  ,  40019  ,  40  ,  0  ,  60  4 
DATA  0  ,  112  ,  0  ,  48  ,  40004  ,-32768  ,  513  ,-16384 
4 

DATA  0  ,-32768  ,  768  ,  0  ,  752  ,  0  ,  239  ,  0  4 
DATA  227  ,-32768  ,  1216  ,-16384  ,  1920  ,  16384  ,  384 

,  40063  4 
'shape  5   girder4 

m»  50  :m2=  25:80SUB  ReadCompressed4 

DATA  8,9,4,0,  1024  ,-1024  ,  30720  ,  13056  4 
DATA  -30976  ,-12544  ,  4096  ,  40002  ,  8192  ,  40005  ,- 
32256  ,  0  4 

DATA  -256  ,-256  ,  768  ,-30976  ,-13312  ,  30720  ,  1228 
8  ,-256  4 

DATA  -256  ,  400214 
'shape  6   ball 4 

m»  30  :m2=  14:G0SUB  ReadCompressed4 

DATA  5,4,4,  30720  ,  18432  ,  22528  ,  30720  ,  122 
88  4 
DATA  30720  ,  30720  ,  12288  ,  18432  ,  40002  ,  18432  , 

40016   4 
*  shape  7   hook4 

m*  182  :m2»  53:G0SUB  ReadCompressed4 

DATA  15  ,  20  ,  4  ,  4088  ,  2032  ,  992  ,  448  ,  448  4 
DATA  448  ,  448  ,  448  ,  448  ,  992  ,  480  ,  448  ,  4032 
4 

DATA  16352  ,  30720  ,-4096  ,-4096  ,  28672  ,  14340  ,  4 
088  ,  4096  4 

DATA  2496  ,  1152  ,  512  ,  40006  ,  512  ,  0  ,  4128  ,  16 
384  4 
DATA  -32768  ,  2048  ,  0  ,-30720  ,  17416  ,  4100  ,  4096 

,  2048  4 


DATA    1024    ,    512    ,    40006    ,     512    ,     0    ,    4128    ,     16384    ,-3 

2768    4 

DATA  2048  ,  0  ,-30720  ,  17416  ,  4100  ,  40120  4 

»UT  (0,0),  shape  (206):  PUT  (30, 0)  ,  shape  (rtl  )4 

=>UT  (60, 0),  shape  (rt2)  :  PUT  (90,0)  ,  shape  (hook)  4 

BET  (90, 12) - ( 105, 20) , shape (shorthook) 4 

GET  (0,0)-(14,23) ,shape(cl)4 

x2=0: y2«0: y3=40: psn-c2: nx=14: ny=23: GOSUB  ReverseBob4 

x2=30:psn=Ltl:nx=13:ny=23: GOSUB  ReverseBob4 

x2=60: psn=Lt2: nx=25: ny=20: GOSUB  ReverseBob4 

RETURN4 
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ReverseBob:4 
FOR  i»  0  TO  nx-14 
FOR  j=0  TO  ny-14 
t=POINT  Ci+x2,j+y2>4 
PRESET  <x2+nx-i, j+y3) ,  t4 
NEXT  j4 
NEXT  i4 

GET  <x2, y3) - (x2+nx , y3+ny) , shape (psn) 4 
RETURN* 
ReadCompressed:  4 
FOR  j=0  TO  m2  4 
READ  t&:s&»s8rM:&4 

IF  t&<40000&  THEN  shape(i2)=t&:i2=i2+l  ELSE  FOR  i=0 
TO  t&-40000&: shape  ( i  +i  2)  =0:  NEXT:  i  2=i  2+t&-40000S<4 
NEXT4 

IF  chk&(ns)Os&  THEN  PRINT  "error  in  checksum"  ;ns:  PR 
INT  "  or  in  shape"; ns; "data  statements": ST0P4 
ns=ns+14 
RETURN4 
4 
De-f  i  nePLayFi  eLd :  4 

SCREEN  1,320,200,4,14 
WINDOW  1, "Climber  5",, 2, 14 
RESTORE  De-f  i  nePLayFi  eLd4 
FOR  i=0  TO  74 
READ  a!,b!,c!4 
PALETTE  i , a ! , b ! , c ! 4 
PALETTE  i+S,a! ,b!,c!4 
NEXT  : PALETTE  8, . 25, . 25, . 254 

DnTn  ■ 45,  ■ 45,   ■ o,   .  1 ,   ■ 1 ,   .  1 ,   ■  85,   ■  o5,   ■  o,   ■  o,   ■ 
7,  .74 

DATA  .85,  .1,  .1,  .6,  .45,  .4,  .45,  .4,  .3,  1,  .6, 
.54 
RETURN  4 
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Stephen  Stout 
Translation  by  Tim  Midkiff 


"Marbles"  is  a  hypnotic  action  program  in  which  you 
try  to  catch  marbles  in  a  bucket.  Act  quickly — and 
don't  panic — in  this  clever  arcade-style  game.  A  joy- 
stick and  Workbench  1.1  or  a  recent  Workbench  1.2 
are  required.  For  1-5  players. 

In  two  weeks,  the  Statewide  Marbles  Championship  will  be 
held  in  Locals ville.  You've  been  practicing  for  nearly  a  year, 
and  now,  at  the  last  minute,  you  find  you've  lost  your  favorite 
marble. 

"Marbles"  is  written  in  BASIC.  Type  it  in  and  save  it  to 
disk.  After  you  have  a  copy  safely  tucked  away,  simply  load 
and  run  the  program. 

To  play  Marbles,  you  must  have  a  Workbench  1.1  disk  or 
the  most  recent  version  of  Workbench  1.2.  The  first  release  of 
1.2  does  not  properly  allocate  sprites  6  and  7. 

A  joystick  plugged  into  port  1  controls  the  buckets  at  the 
bottom  of  the  screen.  You  must  catch  the  red  marbles  in  the 
red  bucket  and  the  blue  marbles  in  the  blue  bucket.  The  ar- 
rows at  the  intersections  of  the  pipes  control  the  flow  of  mar- 
bles. Press  the  fire  button  to  change  the  direction  of  all  the 
arrows  on  the  screen.  The  arrows  move  counterclockwise. 

The  game  of  Marbles  can  be  played  by  up  to  five  players. 
The  one-player  game  starts  with  3  marbles  on  the  screen  at 
once.  After  every  ten  points,  another  marble  is  added  until 
there  are  6  marbles  on  the  screen  at  once.  The  game  ends 
when  40  marbles  have  been  caught.  Your  score  is  the  percent- 
age of  marbles  you  caught. 

In  the  multiplayer  game  (two  to  five  players),  all  contes- 
tants play  the  same  level.  After  each  has  had  a  turn,  the 
player  with  the  lowest  score  is  dropped  from  the  game.  When 
only  one  player  remains,  he  or  she  is  declared  the  winner.  If 
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two  or  more  players  tie  for  low  score,  the  level  is  played 
again. 

Before  running  Marbles,  you  will  either  have  to  move  or 
create  a  file  called  graphics. bmap.  If  you  use  Workbench  1.1, 
you  must  first  copy  the  "graphics.bmap"  file  to  your  boot 
disk.  Follow  the  procedure  given  for  the  "System  Fonts"  arti- 
cle on  page  216. 

Users  of  the  1.2  version  of  the  Extras  disk  should  see  the 
instructions  in  Appendix  B. 

Marbles 

Filename:  MARBLES 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTER'S  Guide  to  Typing  In  Amiga  Programs." 

'Marbles* 

'Copyright  1987  COMPUTE!  Publications,  Inc.* 

'All  Rights  Reserved.  * 

CLEAR  ,25000:  CLEAR  ,  50000S<* 

DEFINT  a-z: RANDOMIZE  TIMER* 

LIBRARY  "graphics. library"* 

DECLARE  FUNCTION  GetSpri te& ( )  LIBRARY* 

DECLARE  FUNCTION  ALLocRasterfc ( )  LIBRARY* 

DIM  sc(21,40) ,pno(21,40) , pi pmap (21,40) , arrow (24, 2) ,  x 

i (30), yi (30)* 

DIM  di (30), ti (30),fbb(12),fbr(12),w(255)* 

SCREEN  1,320,200,4,1: WINDOW  3, , (0, 0) - (31 1 , 186) , 16, 1 : 

WINDOW  OUTPUT  3* 

RESTORE  CoLors:FOR  i-0  TO  15: READ  r ! ,g !, b !: PALETTE  i 

,r  !,g!,b!:NEXT* 

CoLors: * 

DATA  0,0,0, .7, .7, .7, .3, .3, .3, .8,0,. 8, .6,0, .6, .2, .2,. 

2,0,0, .8,0,0, .65* 

DATA  0,0, .5,0,0, .4, .65,0,0, .5,0,0, .4,0,0, .25,0,0, .5, 

■  W,  .  W  ,  .  O  ,  .  O  ,  .  0\ 

PALETTE  22,0,0,1: PALETTE  23,0,0, . 6: PALETTE  26,1,0,0* 

PALETTE  27,. 6, 0,0: PALETTE  30,0,0, Is  PALETTE  31,0,0,-6 

* 

COLOR  1,5:CLS:80SUB  InitSprites* 

ON  BREAK  80SUB  CLoseSprites: BREAK  ON* 

DirDat: RESTORE  DirDat:FOR  i-0  TO  2s READ  dx(i),dy(i): 

NEXT: DATA  -1,0,0,1,1,0* 

RESTORE  Left Arrow: FOR  i-0  TO  24: READ  a*: arrow (i ,0)«V 

AL("&H"+a*):NEXT* 

RESTORE  DownArrow:FOR  i-0  TO  24:READ  a*: arrow (i , 1 )=V 

AL("8<H,,+a*):NEXT* 

RESTORE  Right Arrows  FOR  i-0  TO  24: READ  a*: arrow (i , 2) - 

VAL("&H"+a*):NEXT* 

RESTORE  CupData:FOR  i-1  TO  202: READ  a: cup*-cup*+CHR* 

(a): NEXT* 
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OBJECT -SHAPE  1 , cup*4 

LINE (2, 0) -(6, 0), 7: LINE (0,1) -(8,1), 8: GET (0,0)- (8, l),f 

bb« 

LINE (2,0) -(6,0), ll:LINE(0f 1 ) - (8, 1 ) , 12:6ET (0, 0) - (8, 1 ) 

,fbr4 

NewGame: COLOR  1 ,5: CLS: PRINT  TAB (12)  "Copyright  1987" 

4 

PRINT  TAB(7)  "COMPUTE!  Publications,  Inc.":PRINT  TAB 
(10)  "All  Rights  Reserved. "4 

PRINT: PRINT: PRINT"Number  of  Players  (l-5)"4 
PI Num:k*-"":  WHILE  k*-"":  k*=INKEY*: WEND:  IF  k*<"l"  OR 
k*>"5"  THEN  PlNum4 

CLS: numpL-VAL ( k*) -1 : pts-0: pn-numpL4 

FOR  i-0  TO  255: w(i) -INT (RND*255-128): NEXT: WAVE  3,w4 
IF  numpL-0  THEN4 

X.OCATET  23,  6:  PR  INT  "Marbles:":  LOCATE   23,25:  PRINT"Ratin 
g:  " :npip-34 
ELSE4 

LOCATE  10,l:PRINT"Enter  the  initials  of  player"* 
FOR  i-0  TO  numpL:LOCATE  10,29:PRINT  LEFT*(STR*(i+l) , 
2);: INPUT  nam$(i)4 

nam* ( i ) -LEFT* (nam* ( i ) +SPACE* (3) , 3) : LOCATE  10, 29: PRIN 
T  SPACE* (11):NEXT4 

CLS: of st«INT (34/numpL) : npip-7-numpL4 

FOR  i-0  TO  numpL:cp(i)-i: LOCATE  23, i *ofst+2: PRINT  na 
m*(i):NEXT4 

FOR  i-0  TO  numpL: j-INT(RND* (numpL+1 ) ) :SWAP  cp(i),cp( 
j):NEXT4 
END  IF4 
NewMap:4 

FOR  i-0  TO  2:ck(i)-0:NEXT4 

FOR  i»2  TO  20:FOR  j-2  TO  38: sc (i , j) -0: pno (i , j) =0: pip 
map (i,j)-0: NEXT  j,i4 
IF  numpL>0  THEN4 
LOCATE  23,cp(pn)*ofst+2:C0L0R  4, 5: PRINT  nam*(cp(pn)) 

4 

LOCATE  21,1: PR I NT  SPACE* (40) : IF  pn=numpL  THEN  LOCATE 

24,1:  PRINT  SPACE*  (39);  4 
END  IF4 

pi pe=0: LINE (0,8) -(312, 159),0,bf4 
NewPipe:4 

row=»2:  pi  pe»pipe+l:  COLOR  1,24 
Start: 4 

coL-INT(RND*37)+2:IF  (sc(2,coL-l)  OR  sc(2,coL)  OR  sc 
(2,coL+l))>0  THEN  Starts 
BOSUB  Down: IF  Ln<3  THEN  Start  4 

bal lx (pipe-1 ) -coL: baLLy (pipe-1 ) -row: pi  pmap (2, coL) -24 
LOCATE  2,coL:PRINT"  " ; : sc (2,coL) -pipe: Ln=2: pdir-1 :di 
r=l:GOTO  PLot4 
GetDir:4 

dir-INT(RND*3):ck(dir)-ck(dir)+14 
IF  ck(0)>l  AND  ck(l)>l  AND  ck(2)>l  THEN4 
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IF  pno(row,coL)«pipe  THEN4 

LOCATE  row, coLs COLOR  ,0: PRINT"  ";: COLOR  ,24 
sc (row, coL) =0: pno (row, coL) =0: pi  pmap (row, coL) =04 
END  IF4 

im«im+l:IF  im>10  THEN  NewMap4 
row=row-dy (pdir) :coL=coL-dx (pdir)4 

ck(pdir)«2:ck((pdir+l>  MOD  2)»0:ck ( (pdir+2)  MOD  2)«0 
4 

END  IF4 

IF  sc(row+dy(dir),coL+dx(dir> )=pipe  OR  ck(dir)>l  THE 
N  BetDir4 

IF  dir»0  THEN  GOSUB  Left 4 
IF  dir»l  THEN  GOSUB  Down4 
IF  dir=2  THEN  GOSUB  Right4 

IF  Ln>l  THEN  ck (0)=0:ck ( 1 )=0:ck (2) =0:  IF  Ln>2  THEN  im 
«04 

Ln=INT (RND» (Ln+1 ) ) 4 
PLot :  4 

IF  pdirOdir  AND  Ln>l  THEN  pipmap (row, coL)=dir+l : pdi 
r=dir4 
WHILE  Ln>14 

row»row+dy (dir) :coL=coL+dx (dir) : LOCATE  row, coL: PRINT 
"  ";4 

sc (row, coL ) -pipe: pno (row, coL) =pno (row,coL) +pipe4 
Ln-Ln-1:WEND4 
IF  row<20  THEN  GetDi r4 
IF  pipe<npip  THEN  NewPipe4 

GOSUB  GetIntersect:IF  ni<l  OR  ni >30  THEN  NewMap4 
GOSUB  Mo veBaLLs: COLOR  ,54 
IF  numpL=0  THEN4 

pts=pts+ct-ms:IF  pts<0  THEN  pts=04 

LOCATE  23,14:PRINT  pts"    " : tot=tot+ct+ms: ctot==ctot+ 
ct4 

LOCATE  23,  32:  PRINT  INT  (ctot/tot*100>  •'     "4 
npip*INT(pts/10)+3:IF  npip>6  THEN  EndGame4 
ELSE4 

LOCATE  23, cp (pn> *of st+2: PRINT  nam* (cp (pn) ) 4 
ppts(cp (pn) )=ppts(cp(pn) >+ct: LOCATE  24, cp (pn)*of st+2 
:PRINT  ppts(cp(pn));4 
IF  pn=0  THEN4 

FOR  i=numpL  TO  1  STEP-1:F0R  j=0  TO  i-14 
IF  ppts(cp(j) )<ppts(cp(j+l> )  THEN  SWAP  cp  ( j ) , cp ( j  +  1 ) 
4 

NEXT  j,i4 

IF  ppts(cp(numpL)Kppts(cp(numpL-l>)  THEN4 
npip*npip+l: COLOR  10, 9: LOCATE  21,14 
PRINT  SPACE* <40): LOCATE  21, 13s PRINT  nam* (cp (numpL) ) " 

Eliminated "4 
LOCATE  23, cp(numpL)*of st+2: COLOR  0,5: PRINT  nam*(cp(n 
umpL) )4 
FOR  i»0  TO  numpLrppts (cp  (i  )  )«=0:NEXT:numpL*numpL-l:  IF 

numpL»0  THEN  EndGame4 
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END  IF4 

pn=numpL4 

ELSE* 

pn=pn-14 

END  IF4 

END  IF4 

GOTO  NewMap4 

4 

EndGame:4 

FOR  i-0  TO  5000: NEXT: COLOR  10, 9: LOCATE  21,1: PRINT  SP 

ACE* (40) 4 

LOCATE  21,5:PRINT"End  of  Gam©.   Play  Again  (Y/N>?"4 

k*«"  " :  WHILE  k*»="  "  :  k*-UCASE*  ( INKEY*)  :  WEND4 

IF  k*=,,Y"  THEN  CLS:QOTO  NewGame4 

IF  k»«"N"  THEN  GOSUB  CLoseSprites4 

GOTO  EndGame4 

4 

Left:  4 

i»coL:Ln«04 

LeftCk:4 

Ln-Ln+14 

IF  sc(row+l,i)>0  THEN  IF  sc (row+1, i-1 ) >0  THEN  RETURN 

4 

IF  sc (row-1, i)>0  THEN  IF  sc (row-1, i-1 ) >0  THEN  RETURN 

4 

i -i-1 a  IF  i<2  THEN  RETURN4 

GOTO  LeftCk4 

4 

Right:4 

i«coL:Ln«04 

RightCk:4 

Ln*Ln+14 

IF  sc (row+1 f i)>0  THEN  IF  sc (row+1, i+1 ) >0  THEN  RETURN 

4 

IF  sc (row-1, i)>0  THEN  IF  sc (row-1, i+1 ) >0  THEN  RETURN 

4 

i=i+l:IF  i>3G  THEN  RETURN4 

GOTO  RightCk4 

4 

Down : 4 

i=row:Ln«04 

DownCk:    4 

Ln=Ln+14 

IF  sc(i,coL+l)>0  THEN  IF  sc (i+1 ,coL+l ) >0  THEN  RETURN 

4 

IF  sc(i,coL-l)>0  THEN  IF  sc (i+1 , coL-1 ) >0  THEN  RETURN 

4 

i=i+l:IF  i>20  THEN  RETURN4 

GOTO  DownCk4 

4 

Get Intersect: 4 

ni=04 
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FOR  row-3  TO  19: FOR  coL=l  TO  394 

IF  sc(row,coL)>0  AND  sc (row-1 ,coL) >0  THEN4 

sdn«ABS(sc(row+l,coL) >0) : slt=ABS(sc (row,coL-l ) >0) :sr 

t=ABS (sc (row, coL+1 ) >0) 4 

IF  sdn+slt+srt>l  THEN4 

xi (ni)=(coL-l)*8:yi (ni )= (row-1 ) *84 

IF  sdn=0  THEN4 

ti (ni)«0:di (ni ) *INT (RND*2) *24 

ELSE IF  slt=0  THEN4 

ti (ni)=l:di (ni )=INT (RND*2) +14 

ELSEIF  srt-0  THEN4 

ti (ni)-2:di (ni )*INT(RND*2)4 

ELSE4 

ti (ni)=3:di (ni )=INT (RND*3)4 

END  IF4 

pipmap (row, coL)=di (ni ) +1 : PUT (xi (ni),yi (ni)), arrow (0, 

di (ni)),PSET:ni»ni+14 

END  IF4 

END  IF4 

NEXT  coL,row4 

ni=ni-l:RETURN4 

4 

RotateArrows:  4 

FOR  i*0  TO  ni4 

ON  ti(i)  GOTO  rotl , rot2, rot34 

di (i)=2-di (i):GOTO  104 

rot  1 : di (i)=3-di (i): GOTO  104 

rot2:di (i)=l-di (i):GOTO  104 

rot3:di (i)=(di (i)+l)  MOD  34 

10  pipmap  ( INT  (yi  (i)/8)+l,  INT(xi  (i)/8)+l)=di  (i)+14 

PUT(xi (i),yi (i)) , arrow (0,di (i)) , PSET4 

NEXT:RETURN4 

4 

MoveBaLLs:4 

ct=0:ms=0:cx=156:cy«162:OBJECT.X  1 , 156: OBJECT. Y  1,16 

2:0BJECT.0N  1 : i =STRIG (2) 4 

FOR  i=0  TO  npip-l:CALL  MoveSpri te&(0, spri te&+48*i , ba 

1 1 x ( i ) *8-5, baLLy (i ) *8-13) 4 

NEXT:WHILE  STRIG (2) =0: cx=cx+STICK (2) *8: OBJECT. X  1 , ex 

:FOR  i=0  TO  300: NEXT: WEND4 

bd=04 

WHILE  bd=0:bd=14 

FOR  j=0  TO  npip-14 

IF  baLLy (j)<21  THEN4 

bd=04 

IF  pipmap (baLLy ( j) ,ballx ( j) ) >0  THEN  bal ldir ( j ) =pipma 

p (baLLy (j),ballx (j))-14 

bal 1 x ( j ) =bal 1 x ( j ) +dx (bal 1 di  r ( j ) ) : baLLy ( j ) =baLLy ( j )  +d 

y(balldir  (j))4 

CALL    MoveSprite&(0,sprite8<+48*j,ballx  ( j  )  *8-5,  baLLy  (j 

)*8-5)4 
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ELSE IF  baLLy(j)=21  THEN* 

IF  j«2  OR  j=3  THEN4 

IF  ballx<j)-INT(cx/8)«4  THEN  GOSUB  Catch  ELSE  GQSUB 

Mi  ss: PUT ( (bal 1 x ( j ) -1 ) *8, 170) , f br , PSET4 

ELSE4 

IF  ballx (j)-INT<cx/8)=2  THEN  QOSUB  Catch  ELSE  GOSUB 

Hi  ss: PUT ( <bal 1 x  <  j ) -1 ) *8, 170) , f bb, PSET4 

END  IF4 

baLLy<j)-224 

END  IF4 

NEXT4 

IF  STRIG(2)  THEN  GOSUB  RotateArrows4 

cx«cx+STICK(2)*8:0BJECT.X  lfcx4 

WEND4 

OBJECT. OFF  1 : LINE (8, 170) - (304, 171 ), 5, bf 4 

RETURN4 

4 

Catch: 4 

SOUND  2000,.  5:  CALL  MoveSprite«<(0,  sprit e*<+48*j  ,  -16,0) 

:ct«ct+l:RETURN4 

4 

Miss:4 

SOUND  20,  .5,255,3:ms=cms+l:CALL  MoveSpri  te&<0,  sprit e& 

+48* j , -16, 0) : RETURN4 

4 

Left Arrow: 4 

DATA  7,7,3,1 800 , 2800 , 4E00 , 8200 , 4E004 

DATA  2800 , 1 800 , FE00 , EE00 , CF00 , 8300 , CF00 , EE004 

DATA  FE00, 0, 1000, 3100, 7D00, 3100, 1000, 04 

DATA  0,04 

4 

DownArrow:4 

DATA  7,7,3, 3800 , 2800 , EE00 , 8200 , 44004 

DATA  2800 , 1 000 , FE00 , EE00 , EF00 , 8300 , C700 , EE004 

DATA  FE00, 0, 1000, 1 100, 7D00, 3900, 1000, 04 

DATA  0,04 

4 

RightArrow:4 

DATA  7,7,3, 3000 , 2800 , E400 , 8200 , E4004 

DATA  2800 , 3000 , FE00 , EE00 , E700 , 8300 , E700 , EE004 

DATA  FE00, 0, 1000, 1900, 7D00, 1900, 1000, 04 

DATA  0,04 

4 

CupData:4 

DATA  0,0,0,0,0,0,0,04 

DATA  0,0,0,4,0,0,0,324 

DATA  0,0,0,11,0,24,0,154 

DATA  0,04 

DATA  15,128,15,128,50,64,50,644 

DATA  1 27 , 252 ,127, 252 , 255 , 253 , 255 , 2534 

DATA  55,240,55,240,136, 13,104,134 
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DATA  0f 248, 64, 248, 64, 114,96, 1144 

DATA  99,228,99,228,15,8,15,84 

DATA  0,96,0,964 

DATA  15,240,15,240,48,76,48,764 

DATA  112,6,112,6,96,2,96,24 

DATA  240, 12, 48, 12, 255, 252, 127, 2524 

DATA  127,248, 127,248, 127,240, 127,2404 

DATA  63,224,63,224,15,0,15,04 

DATA  0,0,0,04 

DATA  15,240,15,240,48,76,63,1884 

DATA  112,6, 79, 250, 102, 178, 223, 2554 

DATA  242 ,172, 255 , 255 , 255 , 252 ,143, 2434 

DATA  127,248,128,6,127,240,0,144 

DATA  63,224,64,28,15,0,16,2484 

DATA  0,0,7,2244 

DATA  15,240,15,240,63, 188,63,2524 

DATA  79, 250, 127, 254, 217, 79, 249,  794 

DATA  61 , 95, 253, 95, 15, 243, 255, 2554 

DATA  128,6,255,254,0,14,127,2544 

DATA  64, 28, 127, 252, 16, 248, 31 , 2484 

DATA  7,224,7,2244 

4 

InitSprites:4 

»prite&»=ALLocRaster8e<16,144):IF  sprite&=0  THEN  CLose 

Sprites4 

CALL   BLtCLear* (sprite*,  288,0) 

4 
FOR    i»2    TO   7:offset=48*<i-2)4 

IF  GetSprite8«<sprite8c+o-f-fset,i)<>i  THEN  CLoseSpr it es 
14 

POKEW  sprite&+o-ffset+4,7:P0KEW  sprite&+of  -fset+6,  -174 
RESTORE  BaLLData:FOR  j=16  TO  42  STEP  2: READ  k:POKE  s 
prite&+o-f-fset+j,k:NEXT4 

CALL  ChangeSprite&  (0,  spri  te&+o-f -f  set,  sprit  eSt+o-f-f  set +1 
2)4 

NEXT:RETURN4 
4 

BaLLData:4 

DATA  0,60,0,126,3,255,14 
DATA  255,15,255,6,126,28,604 
4 

CLoseSpr  i  t es : 4 

FOR  i=2  TO  7: CALL  FreeSpri te& (i ) : NEXT4 
CLoseSpr  i  t es 1 : 4 

CALL  FreeRaster&< sprite*, 16, 144)4 

WINDOW  CLOSE  3: SCREEN  CLOSE  1 : ON  ERROR  GOTO  0:END4 
4 
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Family  Fun  and 
Educational  Games 


Word  War 

Peter  Crosby 


This  simple  but  challenging  word  game  pits  you 

against  a  friend  and  is  bound  to  provide  hours  of 

entertainment.  The  game  requires  512K  of  RAM, 

Amiga  Basic,  and  Kickstart  version  1.2. 

"Word  War"  is  a  quick-paced  word  game  that  takes  advantage 
of  the  Amiga's  advanced  features — its  mouse,  many  colors, 
and  excellent  sound.  The  object  is  simple:  Players  guess  letters 
and  words  to  take  over  the  Power  Bar  gauge  located  at  the  top 
of  the  screen.  Whenever  a  player  correctly  guesses  a  letter  or 
word,  his  or  her  color  eats  up  more  of  the  Power  Bar.  When 
one  player's  color  overwhelms  the  other,  the  game  is  over.  In 
essence,  Word  War  combines  the  playing  concepts  of  both 
hangman  and  tug-of-war. 

Typing  It  In 

Word  War  is  written  in  Amiga  Basic.  Type  it  in  and  save  a 
copy  to  disk.  When  you're  ready  to  play,  load  and  run  the 
program. 

Enter  the  names  of  the  two  players.  The  game  screen  will 
appear.  Take  a  moment  to  familiarize  yourself  with  the  screen. 
Near  the  top  is  the  Power  Bar.  At  the  beginning  of  the  game, 
the  left  half  of  the  bar  is  red  and  the  right  is  blue.  As  the  play- 
ers score  points,  the  border  between  the  colors  moves  to  the 
left  or  to  the  right.  Eventually,  one  player  wins  the  game  by 
taking  over  the  entire  bar. 

Below  the  Power  Bar  are  two  boxes  which  hold  the  names 
of  the  players.  Player  1  always  plays  red,  while  player  2  plays 
blue.  During  player  l's  turn,  the  red  box  lights  up.  During 
player  2's  turn,  the  blue  name  box  is  lit.  Both  players  should 
watch  these  boxes  to  be  sure  that  they  do  not  play  their  oppo- 
nent's turn. 
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The  Action  Board  can  be  found  directly  below  the  names 
of  the  players.  At  the  bottom  of  this  board  is  the  alphabet.  A 
mystery  word  appears  in  the  small  box  which  appears  to  hang 
from  the  Board.  At  first  the  word  is  made  up  of  black  squares 
in  the  place  of  the  mystery  word  letters.  Players  use  the 
mouse  to  point  at  and  click  on  the  letter  of  the  alphabet  that 
they  wish  to  guess.  If  the  chosen  letter  can  be  found  in  the 
word,  each  occurrence  of  the  letter  lights  up  in  the  word,  and 
the  player  gets  another  turn.  In  addition,  the  Power  Bar  moves 
slightly  in  favor  of  the  player.  If  the  letter  cannot  be  found  in 
the  word,  the  other  player  gets  a  turn. 

In  the  center  of  the  board  is  a  box  labeled  I  Know  It.  A 
player  who  wants  to  take  a  guess  at  the  mystery  word  can  use 
the  mouse  to  point  at  and  click  on  this  box.  After  selecting  this 
box,  the  player  types  in  his  or  her  guess.  If  it's  correct,  the 
Power  Bar  changes  to  favor  the  player.  If  the  guess  is  incor- 
rect, the  player's  opponent  gains  points  instead. 

When  one  player  needs  to  make  a  desperate  recovery  or 
wants  to  jump  far  ahead  in  score,  he  or  she  clicks  on  one  of 
his  or  her  three  Revival  Squares.  (This  can  be  done  only  dur- 
ing the  player's  turn.)  These  squares  are  located  on  the  ex- 
treme left  (for  the  red  player)  and  the  extreme  right  (for  the 
blue  player)  of  the  Action  Board.  During  the  revival,  a  series 
of  scrambled  words  appears  at  the  top  of  the  screen.  The 
player  must  quickly  unscramble  these  words  and  type  them  in. 
When  time  runs  out,  the  game  returns  to  the  main  screen,  and 
the  revival  points  are  placed  into  the  power  bar.  During  the 
revival,  the  Delete  key  is  inactive.  To  correct  a  typing  error, 
use  the  space  bar  as  a  Delete  key. 

The  accompanying  listing  has  a  vocabulary  of  50  words.  If 
you  wish  to  use  more,  you  must  make  a  few  changes  to  the 
program.  The  arrays  Word$( )  and  RevWord( )  must  be  dimen- 
sioned to  the  number  of  words  in  your  word  data.  (The  words 
are  in  DATA  statements  at  the  end  of  the  program.)  The  49  in 
the  FOR  X  =  0  TO  49  statement  of  the  InitWords  subroutine 
needs  to  be  changed  to  the  number  of  words  you  are  using 
minus  1.  The  number  50  in  the  RND  statements  of  lines  100 
and  550  should  also  be  changed  to  reflect  the  revised  number 
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of  words.  At  the  start  of  each  game,  BASIC  reads  words  from 
the  word  data  into  the  array  word,  checking  for  duplication  as 
it  proceeds.  The  greater  the  number  of  words  used,  the  longer 
the  delay  at  the  start  of  a  game. 

Word  War 

Filename:  WORDWAR 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

'    WordWar4 

'  Copyright  1987  COMPUTE!  Publications,  Inc.  4 

*  All  Rights  Reserved. 4 

Header: 4 

CLS: CLEAR* 

DIM  waveform"/.(255),Word*(50),RevWord(50),PalCol  (12 
,  3) , UsedLetter (26) , Jum* ( 12) , jm ( 12) , Used ( 12)  , Rguess* ( 
12)4 

GOSUB  InitWords4 

GOSUB  MenuSet   4 

FOR  n-0  TO  1274 

wavef  army,  (n)  -127:  NEXT4 

WAVE  0,  wavef  or  m7.4 

SCREEN  2,320,200,5,1: WINDOW  2,"  Word 

War", (0,0)-(311, 186), 16,24 

PRINT  TAB (13) "Copyright  1987": PRINT  TAB (7) "Compute 
!  Publications,  Inc.":4 

PRINT  TAB(11)"A11  Rights  Reserved. ": FOR  t«l  TO  100 
00:NEXT4 

GOSUB  ReadColor4 

GOSUB  RestColor4 

GOSUB  Players  4 

LINE (30, 20) -(282, 32), 31, bf : LINE(23, 10) -( 149, 22) , 21 
,bf : LINE (149, 10) -(275, 22), 23, bf 4 

LINE(22,9)-<276,23),30,b:LINE(21,8)-(277,24),20,b 
4 

LINE(40,39)-(110,52),31,bf : LINE (207, 39) -(278,52)  ,  3 
l,bf4 

LINE (30, 29) -( 100, 42), 24, bf: LINE (29, 28) -(101, 43), 20 
,b4 

LINE(198,29)-(268,42),22,bf :LINE( 197, 28) - (269,43) , 
20,  b4 

LOCATE  5, 5: COLOR  30, 21: PRINT  PI  ay* ( 1 ): COLOR  30,23: 
LOCATE  5, 26: PRINT  Play* (2) : COLOR  20,0   4 

LINE (30, 60) - (282, 145) , 31 , bf : LINE (23, 50) - (275, 135) , 
25, bf : LINE  <23, 50) - (275, 135) , 20, b4 

LINE (35, 136) -(40, 150),28,bf :LINE(38, 136)-(40, 150)  , 
2,bf: LINE (258, 136) -(263, 150) ,28, bf: LINE (261 , 136) - (26 
3,  150), 2, bf 4 

LINE(45,136)-(50,150),31,bf :LINE (268, 136) -(273, 150 
),31,bf   4 
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LINE(30,158)-(282,168),31,bf : LINE (23, 150) - (275, 161 
) , 29, bf : LINE (22, 149) - (276, 162) , 20, b4 

COLOR  20, 0: LINE (99, 81 ) - ( 199, 103) , 27, b4 

LINE (98, 80) -(198, 102), 2, bf : COLOR  30, 2: LOCATE  12,15 
: PRINT" I  Know  It"4 

FOR  y-  66  TO  106  STEP  154 

LINE (35, y+1) -(45, y+1 1), 27, bf : LINE(33, y) - (43, y+10) , 
24,bf4 

LINE (257, y+1 ) - (267, y+1 1 ) , 27, bf : LINE (255, y) - (265, y+ 
i*FJ,22,bf4 

NEXT  y4 

COLOR  20,44 

er$="  "4 

Marker=1494 

Pflag-2: GOSUB  ChangePlay4 

WordNum=-l : BeepFl ag»04 

4 
SetUp: 4 

COLOR  30,0:WordNum«WordNum+14 

LINE(45, 110)-(259, 122) ,27,b4 

LINE(44, 109)-(258, 121 ) , 0,bf : LINE(44, 109)-(258, 121) 
,2,b4 

FOR  x«65  TO  90: LOCATE  15, x-58: PRINT  CHR* (x ) ; :NEXT 
4 

COLOR  20,44 

l»LEN(Word*(WordNum) )4 

LetterLoc=INT ( (39- (1 *2) ) /2) 4 

FOR  x  =  l  TO  14 

LOCATE  20, LetterLoc+x*2: COLOR  ,2+x: PRINT  MID* (Wo 
rd*(WordNum),x, 1)4 

NEXT4 

high«3:NumRight«0:FOR   x*l    TO   26:UsedLetter (x )=0:NE 
XT4 
4 
Moused  ick:  4 

IF  MOUSE  (0)»0  THEN  MouseClick4 

Xletter=M0USE(5)4 

Yletter«M0USE(6)4 

IF  Yletter>110  AND  Yletter<121  AND  Xletter>49  AND 
Xletter<256  THEN  SOSUB  SelectLetter4 

IF  Yletter>80  AND  Yletter<102  AND  Xletter>98  AND  X 
letter<198  THEN  GOSUB  Buesslt4 

IF  Yletter>65  AND  Yletter<120  AND  Xletter>33  AND  X 
letter <43  THEN  GOSUB  Revivel4 

IF  Yletter>65  AND  Yletter<120  AND  Xletter>255  AND 
Xletter<265  THEN  GOSUB  Revive24 

GOTO  MouseClick4 
4 
GuessWord: 4 

COLOR  2,04 

Guess*=CHR* (Sel ect i  on ) 4 
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FOR  g-1  TO  14 

IF  MID* (Word* (WordNum) , g, 1 ) -UCASE* (Guess*)  THEN 
hi gh-g+2: GOSUB  Highlight* 
NEXT  g4 

IF  BeepFlag=0  THEN  SOUND  80, 5, 150, 0: GOSUB  ChangePl 
ay4 

BeepFlag=04 
RETURN4 
4 
Highlight:* 

NumRight=NumRight+14 
IF  NumRight=l  THEN  Winner* 
FOR  x=500  TO  1000  STEP  504 
SOUND  x, 1, 150, 1: NEXT     4 
FOR  x-.l  TO  1  STEP  . 14 

PALETTE  high,x,x,0:FOR  y=0  TO  250: NEXT  y,x4 
Score-3: GOSUB  Score4 
BeepFlag=14 
RETURN4 
4 
SelectLetter:4 

Selection=(INT(Xletter/8)-5)+644 

IF  UsedLetter (Selection-64) =1  THEN  GOTO  ClearMous 
e4 

UsedLetter (Selection-64) =14 

COLOR  0,0:LOCATE  15, Selection-58: PRINT  CHR*(Selec 
tion)4 

GOSUB  GuessWord4 
GOTO  ClearMouse4 
4 
CI ear Mouse: 4 

IF  MOUSE <0)<>0  THEN  ClearMouse4 
RETURN4 
4 
Guesslt: 4 

COLOR  2,254 

a*-INKEY*:IF  ••<>""  THEN  Guesslt4 
IF  a*-CHR*(13)  THEN  Guesslt4 
LOCATE  8,7: INPUT "Your  Guess?  ",gw*4 
IF  UCASE*(gw*)«Word*(WordNum)  THEN  Score- (1-NumRig 
ht)*5:G0T0  Winner 4 

FOR  x-200  TO  50  STEP  -10: SOUND  x , 1 , 150, 2:NEXT4 
LINE(24,51)-(274,65) ,25,bf 4 

Score- ( 1 -NumRi  ght ) *5 : GuessWrong-1 : GOSUB  ChangePl ay 
4 

GOSUB  CI ear Mouse4 
RETURN4 
4 
Winner: 4 

sl-1600:  S2-1000:  s3«800:  S4-600:  st— 1004 
FOR  loop-  1  TO  44 
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FOR  x«sl  TO  s2  STEP  st4 
SOUND  x, 1,150, 1:NEXT4 
FOR  x=s3  TO  s4  STEP  at 4 
SOUND  x, 1,150,1: NEXT    4 
FOR  high»3  TO  1+34 
FOR  x*.l  TO  1  STEP  .14 
PALETTE  high, x,x,0: NEXT  x4 
PALETTE  high,. 4,. 4, 04 
NEXT  high4 

b  1=400:  s2*600:  s3<-800:  s4«1400:  st-1004 
NEXT  loop4 
GOSUB  Scor©4 

COLOR  0, 0: LINE (24, 51 ) - (274, 65) , 25, bf 4 
LINE(23,150)-(275,161),29,bf    4 
GOSUB  RestColor4 
GOSUB  ClearMouse4 
BeepFlag«04 
GOTO  SetUp4 
4 
RestColor:4 

FOR  x»3  TO  16: PALETTE  x, 0,0,0: NEXT  x: PALETTE  20,0, 
0,04 

RETURN4 
4 
InitWords:4 

RESTORE  WordData4 
RANDOMIZE  TIMER4 
FOR  x=0  TO  494 
100  y-(INT(RND*50)):IF  Word* (y) <>""  THEN  1004 
READ  Word* (y) 4 
NEXT  x4 
RETURN4 
4 
ReadColor:4 

PALETTE  0,0, .3,. 34 
PALETTE  1,0, .3,. 34 
RESTORE  ColorData4 
FOR  x«0  TO  114 
FOR  y»0  TO  24 

READ  Pal  Col (x,y)4 
NEXT  y4 
NEXT  x    4 
FOR  x»0  TO  11  4 

PALETTE  x+20,PalCol (x,0),PalCol (x,l),PalCol (x,2)4 
NEXT  x4 
RETURN4 
4 
Players: 4 

COLOR  2,214 

LINE (34, 61 )~ (284, 76), 31, bf: LINE (24, 51) -(274, 66), 21 
,bf : LINE (24, 51) -(274, 66), 20, b4 

LOCATE  8,5:PRINTMPlayer  ttls  ";: COLOR  30, 21: LINE  IN 
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PUT"",Play*(l)  4 

COLOR  2,234 

LINE (34, 92) -(284, 108) , 31 , bf: LINE (24, 82) -(274, 98) , 2 
3, bf : LINE (24, 82) - (274, 98) , 20, b4 

LOCATE  12,5:PRINT"Player  #2:  ";: COLOR  30, 23: LINE  I 
NPUT"",Play*(2)4 

COLOR  20,04 

FOR  x  =  l  TO  24 

IF  LEN(Play*(x))>8  THEN  Play* (x ) =MID* (Play* (x ) , 1 , 8 
)4 

lp=LEN(Play*(x))4 

Play*(x)=SPACE*((8-lp>/2)  +  PI  ay* (x) 4 

NEXT4 

CLS4 

RETURN4 
4 
ChangePlay:4 

IF  Pflag=l  THEN  Switch 14 

IF  Pflag=2  THEN  Switch24 

4 
Switch2:   4 

PALETTE  22, 0,0,. 5: PALETTE  24,1,0,04 

COLOR  30, 24: LOCATE  5, 5: PRINT  PI  ay* ( 1 ) : COLOR  20,22: 
LOCATE  5, 26: PRINT  PI  ay* (2) 4 

COLOR  20,0:Pflag=14 

IF  GuessWrong=l  THEN  GOSUB  Score4 

RETURN4 
4 
Switchl:  4 

PALETTE  22,0,0, 1: PALETTE  24,-3,0,04 

COLOR  20, 24: LOCATE  5, 5: PRINT  Play* ( 1 ): COLOR  30,22: 
LOCATE  5, 26: PRINT  Play* (2)  4 

COLOR  20,0:Pflag=24 

IF  GuessWrong=l  THEN  GOSUB  Score4 

RETURN4 
4 
Score: 4 

IF  Pflag=l  THEN  GOSUB  Playl  ELSE  GOSUB  Play24 

Score=0:GuessWrong=0    4 

RETURN4 
4 
Play2:   4 

IF  Marker-Score=<23  THEN  4 
LINE(23, 10)-(275,22) ,23,bf4 
GOTO  EndGame4 

END  IF4 

Mar ker«Mar ker-Score: LINE (Marker , 10) - (275, 22) , 23, bf 
4 

RETURN4 

4 
Playl:   4 
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IF  Marker+Score->  275  THEN  4 
LINE(23, 10)-(275,22) ,21, bf 4 
GOTO  EndGame4 
END  IF4 

Marker-Mar ker+Score: LINE (23, 10) - (Marker , 22) , 21 , b 
f   4 

RETURN4 
4 
EndGame: 4 

FOR  H-l  TO  154 
FOR  y«0  TO  1  STEP  . 14 
PALETTE  0,y,y,y:FOR  z»l  TO  50:NEXT4 
NEXT4 
NEXT4 

PALETTE  0,0,-3,-34 

LINE (23, 10) -(275, 22), 20, bf: COLOR  30, 29: LOCATE  20,9 
:PRINT  "   '•  Play*(Pflag)  "  has  WON!!!     "4 
200  LINE (24, 51) -(274, 65), 25, bf 4 

COLOR  20, 25: LOCATE  8, 7: INPUT" Another  Game?  ",An* 
4 

IF  UCASE*(An*)=,,N"  THEN  3004 

IF  UCASE*(An*)=,,Y"  THEN  GOSUB  ClearMouse:  GOTO  He 
ader4 

GOTO  2004 
300  MENU  RESET4 

WINDOW  CLOSE  24 
SCREEN  CLOSE  24 
SCREEN  CLOSE  14 
WINDOW  CLOSE  1      4 
END4 
4 
NewGame: 4 

GOSUB  ClearMouse4 
GOTO  Header4 
4 
Revivel:4 

IF  (Pflag-2)  OR  (Rev(l)>2)  THEN  RETURN4 
IF  Yletter>65+(Rev(l>*15)  AND  Yletter<75+ (Rev ( 1 ) *1 
5)  THEN  4004 

RETURN4 
400  LINE (33, 65+ (Rev ( 1 ) * 15) ) - (45, 77+ (Rev ( 1 ) * 15) ) , 25, b 
f4 

COLOR  20,0:Rev(l)-Rev(l)+14 
GOSUB  ClearMouse4 
GOSUB  ReviveMe4 
RETURN4 
4 
Revive2:4 

IF  (Pflag«l)  OR  (Rev(2)>2)  THEN  RETURN4 
IF  Yletter>65+(Rev(2)*15)  AND  Yletter<75+(Rev (2) *1 
5)  THEN  5004 
RETURN4 
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500  LINE(255,65+(Rev(2)*15) )- (267, 77+ (Rev (2) *  15) ) , 25 
,bf4 

COLOR  20,0:Rev(2)=Rev(2)+14 
GOSUB  CI ear Mouse* 
GOSUB  ReviveMe4 
RETURN* 
4 
Revi veMe: 4 

RANDOMIZE  TIMER4 

FOR  x=0  TO  49:RevWord(x)=0:NEXT4 

GOSUB  Reset Val : Score=0: rw=l : pi  t=04 

WINDOW  3,"", (0,0)-(311, 186), 16, 2: IF  Pflag=l  THEN  C 
ol*24  ELSE  Col*224 

LINE (0,0) -(31 1,186) ,20,bf: LINE (15,0) -(296, 182) ,0,b 
f4 

LINE (46,  21) -(286,  32) , 31 , bf : LINE (39, 14) - (279, 25) , 29 
,bf :LINE(38,13)-(280,26) ,20,b4 

FOR  x«l  TO  54 
550  rn«INT(RND*50)4 

FOR  y«l  TO  5: IF  rn=Used(y)  THEN  5504 

NEXT  y4 

IF  RevWord(rn)=l  THEN  5504 

Used  (x )  =rn:  Rev  Word  (rn )  =1 :  Rev*  (x  )  =*Word*  (rn)  4 

NEXT  x4 

GOSUB  TimeBar4 

COLOR  20,0: LOCATE  13, 4: PRINT  "TIME": COLOR  30,04 

LINE(83, 122)-(225, 174) , 31 , bf : LINE (73, 112)-(215, 164 
) ,27,bf : LINE (72, 1 11 ) - (216, 165)  ,  20,  b4 

LINE(240, 120)-(290, 153) , 31 , bf : LINE (230, 1 10) - (280, 1 
43) ,Col,bf4 

LINE(229, 110)-(281, 144) , 20, b: LINE (229, 120)-(281, 12 
0),204 

LOCATE  15, 30: COLOR  20, Col: PRINT  "POINTS" : COLOR  30, 
04 

GOTO  RevLoop4 

4 
Resetval:4 

ln=35:F0R  x  =  l  TO  12: jm (x ) =0: Used (x ) =0: Jum* (x ) =" "  :  N 
EXT4 

Jumbl  e$="  "  :  Unju(n$="  " :  1  n=354 
560  c$=INKEY*4 

IF  c*<>""  THEN  5604 

IF  c$=CHR*(13)  THEN  5604 

RETURN4 

4 
TimeBar:   4 

LINE (40, 40) -(50, 92), 31, bf: LINE (35, 35) -(45, 90)  ,  Col , 
bf4 

RETURN4 
4 
RevLoop:  4 
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1 w=LEN (Rev* ( rw) ): LOCATE  1,10: PRINT  "Press  A  Key  To 
Begin.":b*«INKEY*       4 
IF  b*-""  THEN  RevLoop  ELSE  LINE (40, 0) - (260, 10) , 0, b 
f :LINE(70,48)-(260, 100) ,0,bf 4 

FOR  x-1  TO  lw4 
570  rn«INT(RND*lw+l):  IF  rn«0  THEN  570   4 
FOR  y«l  TO  lw:IF  rn-jm(y)  THEN  570  4 
NEXT  y 

4 
jm (x ) -rn:Jum$ (x ) =MID* (Rev* (rw) , rn,  1 ) 4 
NEXT  x4 

FOR  x«l  TO  lw:  Jumble*«Jumble*+Jum* (x ) +"  ":NEXT:Cen 
t=INT( (24-(lw*2) )/2)4 

COLOR  30, 29: LOCATE  3, 9+Cent: PRINT  Jumble*: COLOR  30 
,04 

FOR  x«l  TO  lw:s=704 
600  a*=INKEY*4 

IF  a*-CHR*(32)  THEN  4 

LOCATE  ll,13+x:PRINT  a*4 
x=x-l:IF  x<l  THEN  x  =  14 
LOCATE  ll,13+x4 
PRINT  a*: a*-"": GOTO  6004 
END  IF    4 

IF  a*»CHR*(13)  THEN  a*=» "  " :  BOTO  6004 
LOCATE  11, 13+x: PRINT  UCASE* ( a* ) ; : COLOR  25,0:PRIN 
T  "_": COLOR  30,04 

IF  a*»""  THEN  4 

LINE(35,INT(ln/25)+32)-(45, INT (ln/25) +32) ,0: In 
=ln+14 

LINE (46, INT (1 n/25) +37) - (50, INT (ln/25) +37) , 04 
IF  ln>1460  THEN  660  ELSE  6004 
END  IF4 

Rguess*  (x )  «a*:  a*"1' M :  NEXT       4 
FOR  x=  1  TO  lw:Unjum*=Unjum*+Rguess*(x) :NEXT4 
IF  UCASE* (Un j urn*) «Rev* (rw)  THEN  650  ELSE  6704 
650  LOCATE  8, 11: PRINT"  That's  Correct!  ":FOR  x-1000 
TO  2500  STEP  100: SOUND  x , 1, 150, 1 : NEXT: Score=Score+20 
:Ucol«30:GOSUB  Print  It: GOTO  6804 

660  LOCATE  8, 11 :PRINT"Sorry,  Out  Of  Time!": SOUND  100 
,5,250, l:Ucol*20:GOSUB  PrintIt:GOTO  6804 
670  LOCATE  8, 1 1 : PRINT"That  Is  Incorrect ." : SOUND  100, 
5,250, l:Ucol =20: GOSUB  PrintIt:GOTO  680   4 
680  LOCATE  17, 31: COLOR  30, Col: PRINT  Score4 
700  GOSUB  ResetVal: COLOR  30,0:GOSUB  TimeBar :rw=rw+l : 
IF  rw<=5  THEN  LINE (39, 14) - (279, 25) , 29, bf : GOTO  RevLoo 

P« 
4 
EndLoop:4 

FOR  x«  1  TO  3000:NEXT4 

CLS: LOCATE  7, 3: PRINT  "Total  Number  of  Revival  Poin 
ts": LOCATE  9, 16: PRINT  Score4 
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FOR  x*  1  TO  5000: NEXT   4 

WINDOW  CLOSE  34 

WINDOW  OUTPUT  24 

BOSUB  Score4 

BOSUB  ChangePlay4 

RETURN4 

4 
Printlt:4 

LINE(39f 14)-<279,25> ,29,bf 4 

FOR  pit«0  TO  lw-14 

COLOR  30, 29: LOCATE  3, 9+Cent+(pi t*2> : It*«MID* (Rev* ( 
rw),pit+l,l>: It*«It*+"  "4 

PRINT  It*: NEXT  4 

FOR  j  =  l  TO  4000:NEXT4 

LOCATE  15+rw, 13: COLOR  Ucol , 27: PRINT  Rev*<rw>4 

pit=04 

RETURN4 
4 
MenuSet : 4 

MENU  1,0,1,  "  "4 

MENU  2,0,1,  "  "4 

MENU  3,0,1,  "  "4 

MENU  4,0,1,  "  "4 

RETURN4 
4 
Col  or Data: 4 

DATA  0,0,0, 1,0,0, -3, 0,0, 0,0, 1,0, 0,-3, 1,-5, 0,-7,0, 1 

,  aw,  ■  j£  ,  0  ,  a  O  ,  a  O  ,  a  04 

DATA  -7, . 1,0, 1,1, 1,0,. 1,0.02  4 

4 
Word Data: 4 

DATA  " FORTHR I GHT " , " CONSULTANT " , " REMEMBER " , " H I GHL I G 
HT"," AUDIBLE "4 

DATA  "PERSONAL", "ADVANCED", "EXECUTE" , "VARIATION" , " 
RESULTS "4 

DATA  " FREQUENCY " , " EV ALU AT I ON " , " I ND I C ATE " , " DURAT I ON 
", "ARGUMENT "4 

DATA  " GENERATE " , " PREC I SE " , " I NFORMED " , " SYSTEM " , " ENC 
0UNTERED"4 

DATA  "FOREIGN", "CONSUMER", "WASHTUB", "SUMMER", "FEAT 
URE"4 

DATA  " TELEPHONE " , " PROGRAM " , " M I CROW AVE " , " TEMPER ATUR 
E"," CONCLUDE "4 

DATA  " RECOMMEND " , " MOT I VAT I ON " , " ECONOM I CS " , " CAPTA I N 
", "DOUBTLESS "4 

DATA  " CONVEN I ENCE " , " M I N I M I ZE " , " TRANSM I SS I ON " , " MECH 
ANICAL",  "CONDITIONS 

DATA  " ELECTR I C AL " , " CHEM I CAL " , " ENG I NEER " , " EFFECT I VE 
"," HORIZONTAL "4 

DATA  " CONCRETE " , " LANGUAGE " , " FUNCT I ON " , " STARTLE " , " K 
N0WLEDGE"4 
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Tiles 

Rick  Harrison 
Translation  by  Tim  Midkiff 

See  if  you  can  repeat  the  pattern  of  colored  tiles  with 

this  challenging  one-  or  two-player  memory  builder. 

((Tiles,,  is  fun  for  kids  and  adults  alike.  The  program 

requires  512K  of  RAM. 

"Tiles"  is  a  game  of  concentration  and  observation.  Putting 
your  memory  to  the  test,  Tiles  offers  amusement  for  game 
buffs  of  all  ages.  To  gain  points,  players  must  memorize  and 
reproduce  different  patterns  of  colored  tiles.  The  number  of 
tiles  increases  as  the  game  proceeds,  making  tile  memorization 
more  and  more  difficult. 

As  a  one-player  game,  Tiles  offers  a  stimulating  challenge. 
With  two  players,  Tiles  becomes  a  competitive  memory  test  as 
each  player  strives  to  attain  a  higher  score  than  his  or  her 
opponent. 

Playing  the  Game 

When  the  game  begins,  a  colored  tile  is  randomly  placed  in  a 
6X10  grid.  The  current  player  must  memorize  the  position 
of  the  tile  in  as  little  time  as  possible.  A  player's  score  de- 
creases by  20  points  for  approximately  every  second  that  the 
tile  is  displayed.  The  time  penalty  becomes  40  points  per  sec- 
ond if  the  player's  score  is  between  2000  and  5000,  and  it 
changes  to  60  points  per  second  if  the  player's  score  is  above 
5000.  Here,  time  is  not  money;  it's  points. 

When  you're  finished  viewing  the  tile  pattern,  the  colored 
tiles  disappear.  You  must  relocate  the  positions  of  the  tiles  in 
the  grid  by  moving  the  pointer.  If  you're  right,  you  gain  100 
points,  but  if  you're  wrong,  you  lose  100  points.  There  is  no 
time  limit  or  order  in  which  hidden  tiles  must  be  found. 

An  extra  tile  is  added  to  the  pattern  every  round.  The 
number  of  tiles  that  you  must  find  is  displayed  on  the  screen. 
The  game  is  over  when  your  score  drops  to  0,  or  if  you  reach 
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the  objective,  which  is  to  successfully  conquer  a  pattern  of  30 
tiles — no  small  task.  A  high  score  is  kept  for  each  player. 

To  view  the  random  pattern  of  tiles,  point  to  the  words 
Click  to  view  in  the  dialog  box  at  the  bottom  of  the  screen  and 
press  the  left  mouse  button.  The  tiles  on  the  screen  will 
change  from  the  default  blue  color,  and  a  random  pattern  of 
colored  tiles  will  appear.  After  you  click,  the  words  Click  when 
ready  appear  in  the  dialog  box,  and  the  clock  starts.  When 
you're  done  memorizing  the  tiles,  click  in  the  dialog  box 
again,  and  the  tiles  return  to  the  default  blue  color.  Now  you 
must  click  on  the  tiles  that  appeared.  To  select  a  tile,  use  the 
mouse  to  point  to  the  desired  tile  and  press  the  left  mouse 
button.  The  current  player's  score  box  is  highlighted  in  the 
two-player  version. 

At  the  end  of  the  game  you  are  asked  if  you  wish  to  play 
again.  If  you  do,  high  scores  are  retained  and  transferred  to 
the  next  game. 

Tiles 

Filename:  TILES 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEI's  Guide  to  Typing  In  Amiga  Programs." 

'Tiles    4 

'Copyright  1988  4 

'COMPUTE!  Publications,  Inc. 4 

'All  Rights  Reserved. 4 

4 

CLEAR  , 25000: DEFINT  a-z : RANDOMIZE  TIMER4 

DIM  hit (59) ,nums(59) ,hrow(30) ,hcoL(30) , pat (1)4 

SCREEN  1,320,200,4,1: WINDOW  3, , (0,0) - (31 1 , 186) , 16, 1 : 

WINDOW  OUTPUT  34 

PRINT  "Copyright  1988": PR I NT "COMPUTE!  Publications, 

Inc.": PRINT" All  Rights  Reserved "4 

FOR  tt=l  TO  3000: NEXT  tt4 

RESTORE  Colors:FOR  i«0  TO  15:READ  r, g, b: PALETTE  i,r/ 

10,g/10,b/10:NEXT4 

Colors: 4 

DATA  1,0,3,6,6,6,2,2,6,7,7,04 

DATA  5,0,0,8,0,0,0,8,0,4,4,44 

DATA  8,8,0,8,0,8,0,8,8,5,0,04 

DATA  0,5,0,5,5,0,5,0,5,0,5,54 

FOR  i-0  TO  59:nums(i)«i:NEXT:0N  TIMER (1)  GOSUB  DecSc 

ore4 

FOR    i-0   TO    10: ci  (i  )-i+5:  NEXT:pat  (1  )-S<HFFFF4 

NewGame:4 
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FOR    i*0   TO    l:hitnum(i  )=0:hnum(i  )=0:  scored  )  =500: high 

(i) =500: NEXT: GOSUB  Board* 

Start: 4 

pL*numpL-pL: IF  score (pL)=0  THEN  Start4 

IF  numpL-1  THEN4 

i»l-pL4 

LINE  (247,31+64*i)-(311,72+64*i)  ,0,b4 

LINE  (249, 33+64*1 ) - (309, 70+64*1 ) , 0, b4 

LINE  (247, 31+64*pL) -(311, 72+64*pL) , 7, b4 

LINE  (249, 33+64*pL) - (309, 70+64*pL) , 7, b4 

END  IF  4 

LINE(17,173)-(227,185),4,bf : COLOR  3,44 

LOCATE  23, 4: PRINT  SPACES (5) "CI ick  to  view"SPACE* (6) : 

k»04 

WHILE  k<>3  AND  k<>4: WHILE  MOUSE (0)< 1 : WEND: k=POINT(MO 

USE ( 1 ) , MOUSE (2) ) : WEND4 

GOSUB  ShowTiLes: LINE (17, 173) - (227, 185) , 4, bf 4 

LOCATE  23, 8: PRINT  "Click  when  ready": COLOR  3,0: TIMER 

ON:k»04 
WHILE  k<>3  AND  k<>4  AND  score(pL)>04 
IF  MOUSE (0)>0  THEN  k -POINT (MOUSE ( 1) , MOUSE (2) )4 
WEND4 

TIMER  OFF:LINE(17,173)-(227,185),0,bf4 
GOSUB  Hi deTiLes: LOCATE  23,8:PRINT  SPACE* (4) "Ti les  =" 
hitnum(pL)+l  SPACE*(3)4 
IF  score (pL>>0  THEN  GOSUB  DoSearch4 
IF  score (pL)>0  THEN4 

hnum  (pL)  =hnum(pL)  +hitnum(pL)  :hi  tnum(pL)  sshitnum(pL)+l 
4 

ELSE4 

GOSUB  Uncover TiLes4 
IF  score (numpL-pL>«0  THEN4 
GOTO  Endgame4 
ELSE4 

LINE ( 17, 173) - (227, 185) , 4, bf : COLOR  3, 44 
LOCATE  23,4:PRINT  SPACE* (4) "Click  to  continue"SPACE* 
(3):k«04 

WHILE  k<>3  AND  k<>4: WHILE  MOUSE (0)< 1 : WEND: k=POINT (MO 
USE ( 1 ) , MOUSE (2) ) : WEND4 
END  IF  4 
END  IF4 

IF  score(pL)>high(pL)  THEN  high (pL)*score(pL) : p=l :G0 
SUB  PrintScore:p=04 

GOSUB  HideTiLes:IF  hitnum(pL)«30  THEN  Endgame  ELSE  S 
tart4 
4 

Dec Score: 4 
dec(pL)«404 
IF  score (pL)<2000  THEN  dec(pL>»20  ELSE  IF  score>5000 

THEN  dec (pL) =604 
score (pL) =score (pL) -dec (pL) : SOUND  9000, - 54 
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IF  score (pL)<=0  THEN  score (pL) =04 

4 

PrintScore: 4 

t*=STR* (score (pL) ) : LOCATE  pL*8+p*2+6, 344 

PRINT  RIGHTS (SPACE* (4) +RIGHT* (t*, LEN (tS) -1 ) , 5) : RETUR 

N4 

4 

ShowTi Le: 4 

x=coL*24+6:y=row*24+16:LINE(x,y)-(x+16,y+16),ci (coL) 

,bf :RETURN4 

4 

Square: 4 

x=coL*24+6:y=row*24+16:LINE(x,y)-(x+16,y+16),2,bf : RE 

TURN4 

4 

Board: 4 

CLS:LINE(0,10)-(245, 159), l,b4 

FOR  row*0  TO  5: FOR  coL=0  TO  9:G0SUB  Square: NEXT  coL, 

row4 

LINE (16, 172) -(228,186) , 1 , b4 

LOCATE  23, 4: COLOR  3: PR I NT "Number  of  players  (l/2)?"4 

k*="": WHILE  k*<>"l"  AND  k$<>"2"  :  k*=INKEYS:  WEND:  numpL 

=ASC(k*)-494 

LOCATE  4, 32: PR I NT "PLAYER  1":LINE  (248, 32) - (310, 71 ) , 1 

,b4 

IF  numpL=l  THEN  LOCATE  12,32: PRINT"PLAYER  2": LINE  (2 

48, 96) -(310, 135) ,l,b4 

FOR  pL=0  TO  numpL:p=0: GOSUB  PrintScore: p=l : GOSUB  Pri 

ntScore:NEXT4 

pL=numpL: p=04 

RETURN4 

4 

DoSearch:4 

hits=04 

Get  Mouse :  WH I LE  MOUSE  (0X1:  WEND4 

x=M0USE(3) :y=M0USE(4): IF  P0INT(x,y)<>2  THEN  Get Mouse 

4 

row=INT( (y-16) /24) :coL=INT( (x-6) /24) : ti Le=row*10+coL 

4 

IF  hit(tiLe)=l  THEN4 

GOSUB  ShowTi Le: score (pL) =score <pL) +100: hi  ts=hi  ts+1 : h 

it <tiLe)=24 

ELSE4 

SOUND  9000, .5:score<pL)=score<pL)-100: IF  score(pL)<= 

0  THEN  score (pL) =04 

END  IF4 

GOSUB  PrintScore: IF  hi ts>hi tnum(pL)  OR  score(pL)=0  T 

HEN  RETURN  ELSE  GetMouse4 

4 

ShowTi Les: 4 

FOR  i«0  TO  59:hit(i)=0:NEXT4 
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FOR  i=0  TO  10:r=INT<RND*ll):t=ci <r):ci <r)=ci <i):ci <i 

)«t:NEXT4 

FOR  i»0  TO  hitnum<pL):r«=INT<RND*60):t=nums<r>:nums<r 

) =nums ( i ) : nums <  i ) =t : NEXT4 

FOR  i»0  TO  hitnum(pL) :hit <nums(i ) )«l:hrow(i )=INT(num 

s(i)/10)4 

hcoL(i )»nums<i )  MOD  10: row=hrow (i ) : coL=hcoL <i ) : BOSUB 

ShowTiLe:NEXT4 
RETURN4 
4 

UncoverTi  Les:  4 

FOR  i-0  TO  hitnum(pL) :tiLe=nums(i )4 
IF  hit<tiLe)«l  THEN4 

pat <0) -&HAAAA: pat  < 1 ) -&H5555: PATTERN  ,  pat 4 
PAINT  ChcoL ( i ) *24+6, hrow ( i ) »24+16> , ci  ChcoL ( i ) ) , 04 
pat  (0)  =8tHFFFF:  pat  ( 1 )  =&HFFFF:  PATTERN  ,  pat 4 
END  IF4 
NEXT:RETURN4 
4 

HideTiLes:4 

FOR  i«0  TO  hitnum(pL) :row«hrow(i ) :coL=hcoL(i ) : 60SUB 
Square: NEXT: RETURN4 
4 

Endgame: 4 

LOCATE  23,7:PRINT"Play  Again  (Y/N)?"4 

k*="": WHILE  kSO'-Y"  AND  k*<>"N"  :  k*=UCASE*  ( INKEY*)  :  WE 
ND4 

IF  k*="Y"  THEN  GOTO  NewGarne  ELSE  WINDOW  CLOSE  3:SCRE 
EN  CLOSE  1:END4 
4 
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This  short,  elegant  program  is  not  only  an  entertain- 
ing activity  for  the  whole  family,  hut  also  a  dem- 
onstration of  valuable  techniques  for  programming 
graphics  in  Amiga  Basic.  The  author  discusses  how 
he  created  the  program. 

"Jigsaw"  is  a  simple,  but  absorbing,  BASIC  game  for  the 
Amiga.  The  program  requires  you  to  put  together  a  puzzle 
after  its  pieces  have  been  scattered  around  the  screen.  The 
Amiga  keeps  track  of  the  number  of  moves  you  make  and  the 
total  amount  of  time  you  take  to  complete  the  puzzle. 

Unshuffle  the  Pieces 

Type  in  the  program  and  save  a  copy  to  disk  before  you  run 
it.  The  program  begins  by  drawing  a  puzzle  shape  in  a  small 
window  in  the  center  of  the  screen.  Wait  until  you  see  a  shape 
that  you  like  and  then  press  the  space  bar.  The  Amiga  then  di- 
vides the  picture  into  a  number  of  equally  sized  pieces,  captur- 
ing each  piece  in  a  small  square  on  the  screen.  While  this  is 
being  done,  you  should  take  advantage  of  the  opportunity  to 
memorize  the  puzzle's  shape.  After  every  piece  has  been  cap- 
tured, the  computer  shuffles  them  at  random.  Begin  playing 
when  the  center  of  the  screen  is  cleared. 

Your  goal  is  to  reconstruct  the  picture  by  placing  each 
piece  in  its  original  position,  using  the  mouse  to  move  pieces. 
To  pick  up  a  piece,  move  the  mouse  pointer  over  the  piece; 
then  press  the  left  button  and  hold  it  down.  The  piece  blinks 
briefly,  and  the  computer  emits  a  beep  to  indicate  that  you 
have  the  piece.  Continue  to  hold  down  the  mouse  button  as 
you  move  the  piece  to  its  destination.  When  you  have  posi- 
tioned the  piece,  release  the  button.  The  square  blinks  a  sec- 
ond time  to  signal  that  it  has  been  placed.  Continue  this 
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process  until  the  entire  picture  is  constructed.  When  you  solve 
the  puzzle,  the  program  lets  you  play  again  or  quit. 

The  bottom  of  the  screen  contains  two  counters:  a  timer 
that  updates  continuously  and  a  move  counter  that  shows 
how  many  turns  you  have  taken.  To  increase  the  game's  diffi- 
culty and  add  to  its  visual  appeal,  the  computer  also  continu- 
ously rotates  the  palette  colors  of  the  puzzle  pieces. 

You  must  place  each  piece  reasonably  close  to  the  desired 
destination  square,  but  you  need  not  line  it  up  exactly.  If  the 
piece  is  close  enough  for  the  computer  to  tell  which  location 
you  intend,  the  program  automatically  "snaps"  it  into  perfect 
alignment. 

If  you  find  yourself  stumped,  you  can  peek  at  the  original 
puzzle  for  a  moment  and  then  return  to  the  puzzle  screen. 
This  is  done  with  the  back-window  and  front-window  gadgets 
located  at  upper  left  of  the  window  border.  To  peek  at  the 
original,  unscrambled  puzzle,  click  the  left  button  once  on  the 
back-window  gadget.  To  return  to  the  puzzle  screen,  click  the 
left  button  once  on  the  front-window  gadget.  There  is  no  pen- 
alty for  peeking.  However,  keep  in  mind  that  the  timer  contin- 
ues to  tick  while  you  study  the  original  shape. 

Beginning  puzzlers  should  avoid  puzzles  that  include 
large  areas  of  blank  space.  Blank  squares  may  look  identical  to 
you,  but  the  computer  remembers  the  original  location  of  each 
piece  and  won't  end  the  game  until  you  place  each  one  in  the 
correct  spot.  Thus,  a  puzzle  that  contains  mostly  blank  space 
can  be  nearly  impossible  to  solve. 

Bobs  and  OBJECT 

Programmers  may  wish  to  study  the  way  that  this  program 
moves  and  places  graphic  shapes  on  the  screen.  One  tech- 
nique that  might  have  been  used  is  to  GET  each  shape  into  a 
variable  and  PUT  it  on  the  screen  wherever  desired.  But  PUT 
and  GET  create  slow,  flickery  animation  in  BASIC.  Instead  of 
PUT  and  GET,  this  program  makes  each  puzzle  piece  into  a 
bob  and  animates  it  with  OBJECT  commands.  The  result  is 
much  smoother  animation.  You  can  still  notice  slight  jerkiness 
in  the  piece's  motion  when  you  carry  it  with  the  pointer,  but 
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this  is  due  to  delays  created  by  background  routines  activated 
by  ON  TIMER. 

The  process  of  creating  a  bob  involves  several  steps.  First, 
GET  is  used  to  capture  all  the  graphic  data  for  each  shape  in 
an  integer  array.  This  integer  array  is  then  converted  into  a 
string  array.  The  string  array,  in  turn,  is  concatenated  into  a 
general  string  array  that  holds  the  bob's  features  and  is  used 
to  animate  the  bob  with  OBJECT.DRAW  commands. 

Jigsaw 

Filename:  JIGSAW 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEVs  Guide  to  Typing  In  Amiga  Programs." 

9      Copyright  1987  COMPUTE!  Publication*,  Inc.* 
'   All  Rights  Reserved* 

4 

DEFINT  a-z4 

DEFSNG  coLrs4 

DEF  FNXYfmRC<cr,w>=<cr-l)*w4 

DEF    FNRCf mXY (xy, w) =INT ( (xy+w) /w> 4 

f aLse=0: true=-14 

ncoLs.  pzL=5:  nrows.  pzLsss44 

xmin. pzL=0: xmax . pzL»149: yrnin.  pzL=0: Move. piece=994 

xwidth= (xmax. pzL-xmin- pzL+1 ) /ncoLs. pzL4 

ywidth= (Move- piece-ymin. pzL+1 ) /nrows. pzL4 

getsize=3+INT< ( 16+xwidth-l ) /16) *ywidth*54 

rmin=l : rmaxs7: cmin=l : cmax=104 

xmin=FNXYf mRC (cmin, xwidth) 4 

xmax=FNXYf mRC (cmax , xwidth ) 4 

ymi  n=FNX Yf mRC (rmi  n , ywi  dth ) 4 

ymax=FNX Yf mRC (rmax , ywi  dth ) 4 

ncoLrs=9:coLrminss6:caLrmaxaBcoLrmin+ncoLrs-14 

vmin^l : vmax«34 

4 

DIM  coLrs(ncoLrs,3) , a(getsize, 1) ,b <getsize)4 

DIM  pcoL (ncoLs. pzL-1 , nrows. pzL-1 ) , prow <ncoLs. pzL-1 , n 

rows. pzL-1 )4 

DIM   coLs (ncoLs. pzLtnrows. pzL-1 ) , rows (ncoLs. pzL*nrows 

-pzL-l)4 

DIM    s$(ncoLs.pzL-l,nrows.pzL-l)4 

4 

PALETTE   0,0,. 3,. 64 

PALETTE    1,1,  1,  14 

4 

d=54 

SUBSTRING*  (26,  0)4 

POKE   SADD(sl*)+ll,d4 

POKE    SADD(sl*)+15,xwidth4 
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POKE  SADD(sl*)+19,ywidth4 

POKE  SADD(sl*)+21,244 

POKE  SADD(sl*)+23,2~d-14 

4 

RESTORE  Nu.CoLors4 

FOR  i=0  TO  ncoLrs    'Get  new  palette  coLors  from  DAT 

A   4 

FOR  j-1  TO  34 
READ  coLrs(i,j)4 
NEXT  j,i4 
4 

RESTORE  CoLs.Rows4 
FOR  i=0  TO  ncoLs.pzL*nrows.pzL-14 

READ  coLs(i):READ  rows (i) 4 
NEXT4 

4 
SCREEN  1, 320, 200, d, 14 
WINDOW  2, "Jigsaw",, 28, 14 
4 

Restart: 4 

CLS: RANDOMIZE  TIMER:  cnoves=04 
4 

coLr. index=ncoLrs:GOSUB  CoLr . Shif t4 
4 

p$a"Press  space  bar  to  stop  puzzle": LOCATE  23,20-INT 
(LEN(p*)/2) -.PRINT  p*;4 

WINDOW  3, "Jigsaw", (80, 70) - (229, 169) , 16, 14 
PAINT  (10, 10), 24 
GOSUB  Make.PuzzLe4 
WINDOW  OUTPUT  24 

LOCATE  23, 20-INT (LEN (p*) /2) : PRINT  STRING* (LEN (p*) , " 
");4 
4 

'Make  Bob  strings  and  place  pieces  on  the  screen4 
cLast=ncoLs. pzL-1 : rLast=nrows- pzL-14 
FOR  irow=0  TO  rLast  4 
FOR  icoL=0  TO  cLast4 

WINDOW  OUTPUT  34 

x=FNXYf mRC ( i  coL+1 , xwi  dth ) : y=FNXYf mRC ( i  row+1 , ywi  d 
th)4 

GET  (x,y)-(x+xwidth-l,y+ywidth-l) ,a(0,0)4 

s*(icoL, irow)=""4 

i Last =get size- 14 

FOR  i*3  TO  iLast:s*(icoL, irow) =s$ (icoL, irow)+MKI 
*(a(i,0) ):NEXT4 

WINDOW  OUTPUT  24 

i=icoL+ncoLs. pzL*irow4 

x=FNXYfmRC(coLs(i ) , x width ): y=FNXYfmRC (rows (i ) , y w 
idth)4 

PUT  (x,y) ,a(0,0)4 

pcoL(icoL, irow)=coLs(i ) :prow(icoL, irow)=rows(i )4 
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NEXT:NEXT4 
WINDOW  24 
4 

*  Shuffle  the  pieces* 
FOR  i=0  TO  204 
Pick.RC:4 

FOR  j=l  TO  24 

coL<j)=INT<ncoLs.pzL*RND):row<j)=INT<nrows.pzL*R 
ND)4 

NEXT  j4 

IF  coL(l)=coL(2)  AND  row ( 1 ) =row (2)  THEN  GOTO  Pick. 
RC4 

FOR  j  =  l  TO  2  4 

x ( j)=FNXYfmRC(pcoL(coL( j) ,row(j) ) ,xwidth)4 
y(j)=FNXYf mRC (prow (coL(j) ,row(j) ) ,ywidth)4 
GET  (x (j) ,y(j))-(x (j)+xwidth-l,y(j)+ywidth-l) ,a( 
0, j-l)4 

LINE  (x(j),y(j))-(x (j)+xwidth-l,y(j)+ywidth-l) ,0 
,bf4 

NEXT  j4 

PUT  (x(l),y(l) ),a(0,l):PUT  (x (2) , y (2) ) , a (0, 0) 4 
SWAP  pcoL (coL ( 1 ) , row ( 1 ) > , pcoL (coL (2) , row (2) ) 4 
SWAP  prow(coL(l) ,row(l) ) , prow(coL(2) ,row(2) )4 
NEXT     4 
'4 

*  Main  loop4 
'4 

t!=TIMER:ON  TIMER  (1)  GOSUB  Show. Time: TIMER  0N4 

done-f  aLse: seLection. mad e=f  aLse4 

GOSUB  Beap4 

WHILE  NOT  done4 

IF  MOUSE (0)~-l  THEN4 

SeLect.Piece:4 

x -MOUSE (5) :y=MOUSE(6)  'get  x  &  y  of  moused 

GOSUB  Fit2Scn  'see  i f  on  screen4 

coL=FNRCf mXY (x ,  x  wi  dth ) : row=FNRCf mXY (y , ywi  dth ) 4 

GOSUB  WhatsThere4 

IF  piece  THEN  4 

coL. piece=cp: row. piece=rp4 

pcoL (coL. piece, row. piece) =-14 

prow(coL. piece, row. piece) =- 14 

GOSUB  Beap  4 

xp=FNX Yf mRC (coL, xwi  dth ) : yp=FNXYf mRC (row,  ywi  dth 


)4 


xdif =xp-x : yd if =yp-y4 

GET  <xp,yp)-(xp+xwidth-l,yp+ywidth-l)  9ai(090)<r 

LINE  (xp,yp)-(xp+xwidth-l,yp+ywidth-l) ,0,bf4 

OBJECT. SHAPE  1 , sl*+s* (coL. piece, row. pi  ece) 4 

OBJECT. X  l,xp: OBJECT. Y  1 , yp4 

OBJECT. ON  14 

seLection. made=true4 
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END  IF4 
END  IF  ' (mouse) 4 
WHILE  seLection. made 4 
WHILE  MOUSE (0) =-14 
x  =MQUSE ( 5 ) : y =MOUSE (6)4 
GOSUB  Fit2Scn4 
IF  xOxp-xdif  OR  yOyp-ydif  THEN4 

x  p=x  +x  d  i  f : y p =y +y d  i  f  4 

OBJECT. X  l,xp: OBJECT. Y  1 , yp4 
END  IF4 
WEND4 
4 

GOSUB  Fit2Scn4 
coL=FNRCf mXY (x , xwidth ) 4 
row^FNRCf mXY (y , ywidth ) 4 
GOSUB  WhatsThere4 
IF  NOT  piece  THEN4 

x=FNXYf mRC (coL, xwi  dth) 4 

y=FNXYf mRC (row, ywi  dth ) 4 

OBJECT. OFF  1:PUT  (x , y) , a (0, 0) 4 

seLection. made=f aLse4 

pcoL (coL. piece, row. piece) »coL4 

prow (coL. piece, row. piece) =row4 

GOSUB  Beap4 

moves=moves+ 1 : LOCATE  23 , 1 3 : PR I NT 


'Moves: " ; moves; 


r0=prow (0, 0) : c0=pcoL (0,0) : count=04 
FOR  r=0  TO  nrows.pzL-14 
FOR  c=0  TO  ncoLs.pzL-14 
IF  (prow(c,r)-r0)=r  THEN4 

IF  (pcoL(c,r)-c0)-c  THEN  count«count+14 
END  IF4 
NEXT  c,r4 

IF  count=nrows. pzLlncoLs. pzL  THEN  done=true4 
END  IF  ' (not  piece) 4 
WEND  ' (seLection) 4 
WEND  ' (done) 4 
TIMER  0FF4 

FOR  i=0  TO  10: GOSUB  Beap:NEXT4 
p*=" Again  (Y/N)?"4 

COLOR  1,0: LOCATE  23, 25: PRINT  p*;4 

p*=H,,:FOR  i=0  TO  1000:  NEXT:  WHILE  p$="  ":  p*=INKEY*:  WEN 
D4 

IF  pS-'V'  OR  p*«,,Y"  THEN  GOTO  Restart4 
SCREEN  CLOSE  14 
END4 
4 
Beap:4 

SOUND  800, 1,100,0: SOUND  1000,1,100,04 

RETURN4 

4 
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Fit2Scn:4 

IF  x<xmin  THEN  x=xmin4 

IF  x>xmax  THEN  x=xmax4 

IF  y<ymin  THEN  y=ymin4 

IF  y>ymax  THEN  y=ymax4 

RETURN4 
4 
WhatsThere:4 

piece=f aLse: cLast=ncoLs. pzL-1 : rLast=nrows. pzL-14 

FOR  c=0  TO  cLast4 
FOR  r=0  TO  rLast4 
IF  pcoL<c,r)=coL  THEN4 

IF  prow(c,r)=row  THEN  piece=true: cp=c: rp=r : RET 
URN4 

END  IF4 

NEXT:NEXT4 

RETURN4 
4 
CoLr. Shift:* 

coLr. index=(coLr. index+1)  MOD  ncoLrs4 

FOR  j=0  TO  ncoLrs-14 

i= (coLr. index+j )  MOD  ncoLrs4 

PALETTE  j  +6, coLrs ( i , 1 ) , coLrs ( i , 2 ) , coLrs ( i , 3) 4 

NEXT4 

RETURN4 
4 

Make.PuzzLe: 4 
FOR  i=0  TO  14 

x (i )=xmax. pzL*RND:y (i > =Move. piece*RND4 
v:4 

vx ( i ) =2*vmax  *RND-vmax : vy ( i ) =2*vmax  *RND-vmax4 
IF  vx(i)=0  OR  vy(i)=0  THEN  GOTO  v4 
NEXT4 

coLr =coLrmi  n4 
WHILE  INKEY$=,,U4 
FOR  i=0  TO  14 

x  (i  )=x  (i  >+vx  (i  )4 

y  (i  )«y  (i  )+vy  (i  )4 

IF  x  (i  X=xmin.pzL  OR  x  (i  )  >=xmax  .  pzL  THEN4 
vx (i )=-SGN(vx (i ) ) * (RND(vmax ) +vmin> 4 

END  IF4 

IF  y  (i  X=ymin.pzL  OR  y <i ) >=Move. piece  THEN4 
vy(i  >=-SGN(vy (i ) ) * (RND(vmax ) +vmin> 4 

END  IF4 
NEXT4 

coLr=coLr+l : IF  coLr>coLrmax  THEN  coLr=coLrmin4 
LINE  (x  <0>,y(0))-<x  (D,y(l)),coLr4 
WEND    4 
RETURN4 
4 
Show. Time: 4 
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T2!=TIMER4 

LOCATE  23,1:PRINT  "Time: M ; CINT <T2 f -t ! ) ; 4 
GOSUB  CoLr. Shifts 
RETURN4 
4 

Nu.CoLors:4 
DATA  .99,-05,-034 
DATA  .99,-70,-034 
DATA  .59,-99,-034 
DATA  .03,-99,-114 
DATA  .03,-99,-814 
DATA  .03,-51,-994 
DATA  .22,-03,-994 
DATA  .89,-03,-994 
DATA  .99, .03,-404 
4 

CoLs.Rows:4 

DATA  1 ,  1 ,  2,  2,  1 ,  3,  2,  4,  1 ,  5,  2,  6,  1 ,  74 
DATA  9, 1, 10,2,9,3,10,4,9,5, 10,6,9,74 
DATA  3,1,4,2,5,1,6,2,7,1,8,24 
4 
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Applications 


Banner  Printer 

Walter  Bulawa 

Here's  a  banner-printing  program  with  an  interesting 

feature.  In  addition  to  the  usual  Amiga  characters, 

you  can  use  any  of  the  Amiga's  disk-based  custom 

character  fonts.  A  dot-matrix  or  laser  printer 

is  required. 

This  Amiga  Basic  program  allows  you  to  construct  and  print  a 
banner  of  enlarged  letters  using  any  of  the  13  fonts  present  on 
the  Workbench  disk.  You  can  use  any  combination  of  fonts  on 
the  same  banner. 

Program  1,  the  banner  printing  program,  requires  that  two 
special  files  called  graphics.bmap  and  diskfont.bmap  be  present. 
Users  of  Workbench  1.2  should  follow  the  procedure  outlined 
in  Appendix  B.  Users  of  Workbench  1.1  should  type  COPY 
Extras:BasicDemos/graphics.bmap  TO  Libs:  at  the  CLI  prompt. 
To  create  diskfont.bmap,  users  of  Workbench  1.1  can  run  Pro- 
gram 2.  (This  program  is  taken  from  Advanced  Amiga  BASIC 
by  Tom  Halfhill  and  Charles  Brannon,  available  from  COM- 
PUTE! Books.)  Once  you've  used  Program  2  to  create 
diskfont.bmap,  you  won't  need  Program  2  again  except  to  cre- 
ate additional  copies  of  that  file. 

Banner  Construction 

When  you  run  Program  1,  it  opens  a  window  where  you  can 
construct  a  banner.  The  white  area  near  the  bottom  of  the 
window  represents  the  printer  paper,  with  the  left  edge  of  the 
display  corresponding  to  the  top  edge  of  the  printer  paper. 
The  small  vertical  line  is  the  cursor. 

Letters  that  you  type  on  the  keyboard  appear  in  the  work 
area  with  the  current  character  font.  You  can  move  the  cursor 
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to  any  position  in  the  white  work  area  by  dragging  it  with  the 
mouse  pointer.  The  Mouse  menu  allows  you  to  use  the  mouse 
for  two  other  purposes  as  well:  drawing  and  erasing  pixels  in 
the  work  area.  This  facility  lets  you  add  graphics  to  text  or 
erase  text  that  you  wish  to  eliminate. 

The  upper  portion  of  the  window  indicates  which  font  is 
currently  in  use.  To  change  fonts,  simply  choose  the  desired 
font  from  the  Font  Selection  menu.  Except  for  the  Topaz  fonts, 
which  are  contained  in  ROM,  new  fonts  will  be  loaded  from 
the  Workbench  disk.  Once  the  program  has  found  the  font,  it 
identifies  and  displays  the  font  on  the  screen.  You  may  then 
type  in  the  work  area  with  that  font. 

It  is  important  to  remember  that  the  white  area  represents 
the  banner  as  it  will  be  produced  on  the  printer.  So,  should 
you  wish  larger  letters  for  the  banner,  use  the  Box  Height 
menu  to  select  a  narrower  height  for  the  white  area.  The  more 
you  shrink  the  work  area,  the  larger  the  characters  appear  on 
the  paper.  Changing  the  work  area's  height  always  erases  the 
work  area  completely. 

This  program  ordinarily  uses  the  X  character  to  form  the 
banner  characters.  However,  you  can  select  a  different  printing 
character  with  the  Change  Printer  Char  option  of  the  Action 
menu.  Simply  type  the  new  character  when  prompted. 

Printing 

Once  you  have  finished  writing  on  the  work  area,  choose  the 
Print  Banner  option  from  the  Action  menu  to  print  the  banner. 
Make  sure  that  the  printer  is  connected  and  turned  on  before 
you  take  this  action.  It's  also  important  that  you  use  the  cor- 
rect printer  driver  for  your  printer.  To  check  or  change  the 
printer  driver,  click  on  the  Preferences  tool  from  the  Work- 
bench and  choose  the  Change  Printer  option. 

You  can  abort  the  printing  at  any  time  by  pressing  the 
ESC  key.  Printing  always  begins  at  the  left  margin  of  the  work 
area;  to  avoid  wasting  paper,  it's  usually  best  to  locate  the  first 
character  close  to  the  left  margin.  If  your  banner  message 
doesn't  completely  fill  the  text  window,  the  printer  will  print 
blank  lines  representing  the  unused  portion.  To  avoid  wasting 
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paper,  you  may  want  to  press  ESC  to  halt  printing  as  soon  as 
all  of  your  message  has  been  printed. 

When  the  banner  is  printed,  the  characters  tend  to  look 
somewhat  stretched  compared  to  their  appearance  on  the 
screen.  The  Printer  lines/display  column  option  allows  you  to 
correct  for  the  stretching  effect,  depending  on  what  height  is 
selected  under  the  Box  Height  menu.  Good  results  can  often 
be  obtained  by  using  a  value  about  half  as  large  as  the  default 
value. 

Program  1.  Banner  Printer 

Filename:  BANNER 

For  instructions  on  entering  these  programs,  please  refer  to  Appendix  B, 
"COMPUTEVs  Guide  to  Typing  In  Amiga  Programs." 

"   Copyright  1987  COMPUTE!  Publications,  Inc. 4 
AI]  Rights  Reserved* 

* 

DEFINT  a-z4 

LIBRARY  "graphics. library"* 

LIBRARY  "disk-font,  library"* 

DECLARE  FUNCTION  OpenDi skFontfc ( )  LIBRARY* 

DECLARE  FUNCTION  OpenFont&O  LIBRARY* 

DIM  TextAttr&d)  ,  FontName*  ( 13)  ,  FontSize  <  13)  * 

DIM  choice(4)* 

xmin=0: xmax=615: ymin=107: ymax=184: LpCX=l : CpL%=l* 

f alse=0: true=-l: kwit=f alse* 

pen=l : choice (2) =1 : choice (3) =4* 

xe=70:ye=20* 

PChar*="X"* 


MENU  1,0,1 
MENU  1,1,1 
MENU  1,2,1 
MENU  1,3,1 
MENU  1,4,1 
MENU  1,5,1 
* 

MENU  2,0,1 
MENU  2, 1,2 
MENU  2,2,1 
MENU  2,3,1 
* 

MENU  3,0,1 
MENU  3, 1,1 
MENU  3,2, 1 
MENU  3,3, 1 
MENU  3,4,2 


Action"* 

Print  Banner"* 

Erase  Box"* 

Change  Printer  Char"* 

Change  Ptr  lines/col"* 

Quit"* 

Mouse"* 
Draw"* 
Erase"* 
Position  cursor"* 

Box  Height"* 
10  pixels"* 
20  pixels"* 
40  pixels"* 
80  pixels"* 
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4 

MENU  4,0,l,"Font  Selection"* 

FOR  i"/.=  l  TO  134 

READ  Font  Name*  ( i  "/.)  ,  Font  Si  ze  ( i  7.)  4 

MENU  4,i7.,  1,"   "+FantName*(i"/.)+STR$(FontSize(iy.)>4 
NEXT  i"/.   4 
4 

'Set-up  the  Screen  Display4 
COLOR  3,04 

LOCATE  3,1: PR I NT  "Font:" 4 
LOCATE  7,1: PRINT  "Printer  character: "4 
PRINT  "Printer  lines/display  column:"4 
COLOR  1,04 

LOCATE  7, 20: PRINT  PChar*4 
LOCATE  8,  30:  PRINT  LpC7.4 
'Get  Info  on  current  font4 
Rp&=WIND0W<8)4 

CALL  AskFontSc  (RpSc,  VARPTR  (Tex tAttrfc  (0)  >  )  4 
FontSi  ze=Tex t Attrfc  ( 1 )  \655368c4 
FontName*»,,topa2  "4 

Font-  Default8c=OpenFont8c  (VARPTR  (Tex tAttr&(0)  )  )4 
Font  -  Ac t  i  ve8c=Fon t .  De-f  aul t &4 
BaseLi  ne=PEEKW ( Rp&+62 ) 4 
GOSUB  Show. Ex amp le4 

GOSUB  Erase. Box  'Display  Banner  Box 4 
4 

'Main  Loop4 

ON  MOUSE  GOSUB  Mouse. Action: MOUSE  0N4 
ON  MENU  GOSUB  Menu. Request: MENU  0N4 
4 

WHILE  NOT  kwit4 
c*=INKEY*4 
IF  c*<>""  THEN4 

IF  ASC(c*)=13  THEN4 
GOSUB  Erase. Cursor4 
xcsxmin: yc=yc+FontSize+34 
GOSUB  Yc.Check4 
GOSUB  Move.Cursor4 
ELSE4 

GOSUB  Erase. Cursor4 
COLOR  2,14 

PRINT  RIGHT* (c*, 1) ;4 
xc«PEEKW (Rp&+36) : yc=PEEKW (Rp&+38) 4 
GOSUB  Show. Cursor  'display  new  cursor4 
END  IF4 
END  IF   4 
WEND4 
4 
Done: 4 

COLOR  1,04 
MENU  RESET4 
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CALL  CloseFont&(Rp&,  Font.  Active**)  4 

CALL  SetFontfc (Rp&, Font . Def aul t&) 4 

LIBRARY  CL0SE4 

END4 
4 
house  . Ac t  i  on : 4 

WHILE  MOUSE (0)<>04 

mx  =MOUSE ( 1 ) : my =MOUSE (2)4 

IF   mx<xmin    THEN   mxs=xmin4 

IF    mx>xmax    THEN   mx=xmax4 

IF  cursor. mode  THEN         'Move  cursor  w/mouse4 
BOSUB  Erase. Cursor4 
yc=my:xc=mx4 
GOSUB  Yc.Check4 
GOSUB  Move.Cursor4 

ELSE  'Draw  w/mouse   4 

IF  my<ymin  THEN  my=ymin4 
IF  my>ymax  THEN  my=ymax4 
PSET  (mx,my),pen4 

END  IF4 

WEND4 
RETURN4 
4 

Menu. Request : 4 
mnu*MENU ( 0) : i  tem=MENU (1)4 

IF  choice (mnu)<>0  THEN  MENU  mnu, choice (mnu) , 14 
choi  ce (mnu) ^i  tem4 
MENU  mnu, choice (mnu) ,2  4 

ON  mnu  GOSUB  Menu. 1 , Menu. 2, Menu. 3, Menu. 44 
c*=""4 
RETURN4 
4 
Menu. 1: 4 

ON  item  GOSUB  Print . it , Erase. Box , Choose. PChar, Choo 
se.LpC,Quit4 
RETURN4 
4 
Menu. 2: 4 

IF  item=l  THEN  pen=24 

IF  item=2  THEN  pen=14 

cursor. mode-f al se4 

IF  item=3  THEN  cursor . mode=true4 

RETURN4 
4 
Menu. 3: 4 

LINE  (xmin, ymin) - (xmax , ymax ) , 0, bf  'erase  old  box4 

BoxHeight7.=  10*2^<item-l)4 

ymax  =ymin+Box  Height?.- 14 

GOSUB  Erase. Box   'display  new  box4 

LpC7.=80/BoxHeight7.:CpL7.=LpC7.4 

CALL  SetFont&(Rp&,Font.Default8<)4 
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COLOR  1,0:  LOCATE  8,  30:  PRINT  LpC7.4 

CALL  SetFont&(Rp&,  Font.  Active**)  4 

GOSUB  Move.Cursor4 
RETURN4 
4 
Menu. 4: 4 

F=»04 

Tex tAttrfc (0) =SADD (Font Name* (i  tern) +" . font "+CHR* (0) ) 
4 

Tex  t Attr& ( 1 ) =FontSi  ze ( i  tern ) *65536&4 

IF  item<3  THEN4 

FSe=OpenFont&(VARPTR(TextAttr&(0)  )  )  'ROM  fonts4 

ELSE4 

F&=OpenDiskFont&(VARPTR(TextAttr&(0) ) )  'Disk  fon 
ts4 

END  IF4 

IF  F&=0  THEN  RETURN4 

GOSUB  Erase. Example: GOSUB  Erase. Cursor4 

IF  Font.  Act  ive&<>0  AND  Font .  Act  ive&OFont.  De-fault  8c 
THEN  CALL  CI oseFontfc (Rp&, Font . ActiveX) 4 

Font. Act i ve&=F&4 

FontSize=FontSize(item)4 

FontName*=FontName*  <  i  tern) 4 

CALL  SetFont&(Rp8<,  Font.  ActiveX)  4 

BaseLi  ne=PEEKW (Rp&+62)  4 

GOSUB  Show. Ex amp le4 

GOSUB  Yc.Check4 

GOSUB  Move.Cursor4 
RETURN4 

4 
Choose. PChar :  4 

CALL  SetFontfc (Rp&, Font . Def aul t&) 4 

COLOR  1,0: LOCATE  10,1: PRINT  "Enter  new  printer  cha 
racter:  _"4 

c*«" " : WHILE  c*=" " : c*=INKEYS: WEND4 

IF  ASC(c*)>32  THEN4 
PChar*«c*4 
LOCATE  7, 20: PRINT  PChar*4 

END  IF4 

LOCATE  10,1:PRINT  STRING* (30, 32)4 

CALL  SetFont&(Rp8c,  Font.  ActiveX)  4 

GOSUB  Move.Cursor4 

GOSUB  Delay4 

RETURN4 
4 
Choose. LpC: 4 

CALL  SetFont&(Rp8c,Font.Default&)4 

COLOR  1,0: LOCATE  10,1: PRINT  "Enter  lines/col:  _"4 

c*=" " : WHILE  c*«" " : c*=INKEYS: WEND4 

IF  VAL(c*XLpC"/.  AND  VAL(c*>>0  THEN4 
LpC7.=VAL(c*)4 
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LOCATE  8,  30:  PRINT  LpC7.4 
END  IF4 

LOCATE  10,1: PRINT  STRING* (30, 32) 4 
CALL  SetFont&<RpS<,Fant.ActiveS<)4 
GOSUB  Move. Cursor 4 
GOSUB  Delay* 
RETURN* 

Print. it:  4 
Prt . Stop=f al se4 
OPEN  "PRT:"  FOR  OUTPUT  AS  #14 
PRINT  #1 , CHR* (27) ; " C0z " ; CHR* (27) ; "#3" ; 4 
CALL  SetFont8c(Rp&,  Font.  Default^)  4 

COLOR  1,0: LOCATE  10, 1 : PRINT"Press  ESC  to  Abort  Pr in 
t"4 
FOR  x=xmin  TO  xmax4 
p*=""4 

IF  INKEY*=CHR*(27)  THEN  GOTO  Print. Done4 
FOR  y=ymax  TO  ymin  STEP  -14 
IF  POINT (x,y)<>l  THEN4 

c*=PChar*4 
ELSE4 

c*="  "4 
END  IF4 

FOR  i  =  l  TO  CpL7.:p*=p*+c*:NEXT4 
NEXT  y4 

FOR  i  =  l  TO  LpC7.4 
PRINT  #l,p*4 
NEXT  i4 
NEXT  x  4 

Print .Done:4 
CLOSE  #14 

LOCATE  10,1: PRINT  STRING* (30,"  ")4 
CALL  SetFont&(Rp&, Font. ActiveX) 4 
GOSUB  Move.Cursor4 
RETURN4 
4 
Erase. Box :4 

LINE  (xmin, ymin) - (xmax , ymax ) , 1 ,bf 4 
xc*xmin: yc=ymin+BaseLine4 
GOSUB  Move.Cursor4 
RETURN4 
4 
Quit: 4 

kwi t=true4 
RETURN4 
4 
Move . Cur  sor : 4 

CALL  move&(Rp8(,xc,yc)4 
Show. Cursor : 4 

ytemp^yc-BaseLi  ne4 
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LINE  <xc,ytemp)-(xc,ytemp+FontSize-l) ,34 

RETURN* 
4 
Yc. Check: 4 

ymn=ymi  n+BaseLi  ne4 

IF  yc<ymn  THEN  yc=ymn4 

ymx  =ymax -Font Si  z  e+BaseLi  ne+ 1 4 

IF  yc>ymx  THEN  yc=ymx4 

RETURN4 

4 
Erase. Example:  4 

COLOR  0,04 

CALL  move&(Rp&,xe,ye)4 

CALL  ClearE0L8c(Rp&)4 

RETURN4 

4 
Show. Example:  4 

COLOR  2,14 

CALL  move&<Rp&,xe,ye)4 

c*=FontName*+STR* (FontSi  ze) 4 

CALL  Text8<  <Rp&, SADD <c*)  ,LEN(c*)  )4 

RETURN4 
4 
Erase. Cursor:  4 

ytemp^yc-BaseLi  ne4 

LINE  (xc,ytemp) - (xc, ytemp+FontSize-1 ) , 14 

RETURN4 

4 
Del  ay: 4 

FOR  j"/.=  l  TO  1000:NEXT4 

RETURN4 

4 
FontTypes: 4 
DATA  topaz, 8, topaz,  94 
DATA  diamond, 124 
DATA  garnet, 9, garnet, 164 
DATA  ruby, 8, ruby, 124 
DATA  emerald, 204 
DATA  opal, 114 

DATA  sapphire, 14, sapphire, 15, sapphire, 18, sapphire, 19 
4 

4 
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Program  2.  Diskfont.bmap  Filemaker 

Filename:  FONTBMAP.MAKER 

'   Copyright  1987  COMPUTE!  Publications,  Inc. 4 

*   All  Rights  Reserved* 

4 

'DiskfontMaker4 

f  i 1 e*= " 1 i  bs: Di  skf ont . bmap " 4 

READ  f ilesize,checksum4 

PRINT  "Checking  DATA  statements. . .": PRINT  4 

FOR  i«l  TO  filesize4 

READ  a*:a=»VAL<"&h"+a*>4 

check"check+a4 
NEXT  i4 

RESTORE  DiskFontData4 

IF  checkOchecksum  THEN  PRINT  "Checksum  mismatch  — 
error  in  typing. ":END4 
PRINT  "DATA  ok,  creating  the  file. "4 
ON  ERROR  GOTO  CreationError4 
OPEN  file*  FOR  OUTPUT  AS  #14 
FOR  i»l  TO  filesize4 

READ  a*:a-VAL<"8«h,,+a*)4 

PRINT#l,CHR*<a>;4 
NEXT  i4 
CL0SE#14 

PRINT  "Finished. "4 
END4 

CreationError:4 
PRINT  "ERROR  #";ERR:END4 
4 

DATA  34,31964 
DiskFontData:4 

DATA  4F,  70,  65,  6E,  44,  69,  73,  6B,  46,  6F,  6E,  74,  00,  FF,  E2,  09 
4 

DATA  00, 41 , 76, 61 , 69, 6C, 46, 6F, 6E, 74, 73, 00, FF, DC, 09, 01 
4 
DATA  02,004 
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Menu  Planner 

W.  M.  Shockley 
Translation  by  Tim  Midkiff 

For  those  who  like  to  plan  ahead,  here's  an  easy-to- 
use  BASIC  program  that  Jets  you  plan  dinner  menus 
for  an  entire  week  in  advance.  Easy  to  use  and  fea- 
ture packed,  "Menu  Planner"  is  a  simply  conceived 
and  structurally  sound  program  that  is  open-ended 
for  user  customizing.  A  disk  drive  is  required.  A 
printer  is  optional. 


In  a  world  where  there's  almost  always  too  much  to  do,  a 
computer  can  be  a  wonderful  ally.  "Menu  Planner77  is  a  time- 
saving  program  which  allows  you  to  plan  an  entire  week  of 
daily  menus  in  advance,  with  only  a  few  minutes  at  the  key- 
board. When  the  menu  is  complete,  it  can  be  printed  out  for 
use  in  shopping  and  in  preparing  meals.  Previous  menus  can 
be  loaded  from  disk  and  reviewed,  reused,  or  edited.  Since  the 
entire  program  is  written  in  BASIC,  it's  also  a  simple  matter  to 
customize  it  for  your  own  particular  needs.  Type  in  the  listing. 
Be  sure  to  save  a  copy  before  running  the  program. 

Main  Menu 

Menu  Planner  is  a  menu-driven  program,  meaning  that  you 
make  program  choices  by  selecting  from  convenient,  onscreen 
menus.  When  you  first  run  the  program,  it  prints  the  main 
menu  on  the  screen.  By  pressing  the  indicated  letter  keys,  you 
can  make  a  new  menu,  review  the  current  menu,  print  the 
current  menu,  save  the  current  menu,  load  a  previous  menu 
from  disk,  edit  the  current  menu,  or  quit  the  program. 

For  instance,  the  first  time  you  use  Menu  Planner,  you 
will  want  to  press  M  to  make  a  new  menu.  The  computer 
clears  the  screen  and  prints  a  new  display  with  onscreen 
prompts  that  tell  you  what  to  do. 

You  will  be  creating  a  dinner  menu  for  each  day  of  the 
week,  beginning  with  Sunday.  You  begin  with  the  entree: 
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Choosing  from  the  program's  built-in  list  of  entrees,  Menu 
Planner  prints  the  first  entree  choice  on  the  screen.  To  move 
to  the  next  entree,  press  the  space  bar.  Continue  cycling 
through  entree  selections  until  you  find  the  one  you  want; 
then  press  RETURN  to  select  it. 

Under  the  entree  section  is  a  special  offering  called  Eat 
Out.  If  you  select  this  choice,  the  program  jumps  to  the  next 
day  of  the  week.  The  last  selection  in  each  category  is  called 
Choice.  This  selection  allows  you  to  type  in  any  food  that  is 
not  offered  in  the  program's  built-in  list. 

After  you  choose  an  entree,  the  same  process  is  repeated 
for  three  additional  categories:  a  vegetable  dish,  a  starch  or 
bread  dish,  and  a  dessert.  When  you  have  completed  an  entire 
meal,  the  entire  cycle  repeats  until  you  have  made  an  entire 
week  of  menus.  At  this  point,  the  main  menu  reappears. 

Other  Options 

The  Review  option  lets  you  review  the  entire  current  menu, 
one  meal  at  a  time.  Press  the  space  bar  to  continue  to  the  next 
meal. 

The  Print  Out  option  prints  a  menu  to  a  printer  with  a 
couple  of  extra  items  to  aid  you  in  shopping  for  the  week.  Be 
sure  that  the  printer  is  connected  and  turned  on  before  you  se- 
lect this  option. 

The  Save  Current  Menu  option  saves  the  current  menu  to 
disk.  When  you  select  this  option,  Menu  Planner  prompts  you 
to  enter  a  number  for  the  menu.  Enter  a  1  for  the  very  first 
menu,  2  for  the  second,  and  so  on.  You  do  not  have  to  type  in 
a  filename:  Menu  Planner  automatically  creates  a  filename 
using  the  number  you  supply.  Do  not  use  the  same  number 
twice. 

The  Load  Old  Menu  option  loads  an  existing  menu  from 
disk.  This  selection  should  be  used  whenever  you  want  to  re- 
view, edit,  or  print  out  an  old  menu.  Again,  you  don't  need  to 
type  in  a  filename.  Simply  enter  the  number  of  the  menu  you 
wish  to  load. 

The  Edit  option  allows  you  to  change  an  existing  menu. 
This  is  done  by  reentering  the  selections  for  an  entire  day. 
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Note  that  you  must  have  a  menu  in  memory  before  you  select 
this  option  (if  you  don't,  Menu  Planner  has  nothing  to  edit). 
Type  in  the  day  of  the  week  when  prompted;  you  must  spell 
out  the  day  completely  (for  instance,  type  MONDAY  instead 
of  MON).  When  the  menu  has  been  altered,  the  main  program 
menu  reappears.  This  feature  simplifies  the  process  of  making 
similar  menus.  Simply  reload  an  old  menu,  change  the  meals 
for  one  or  more  days,  and  then  resave  it. 

The  Quit  option  ends  the  program.  If  you  have  not  al- 
ready saved  the  current  menu,  be  sure  to  do  so  before 
quitting. 

Customizing  Menu  Planner 

The  program  can  be  changed  easily  for  personal  preference. 
For  example,  you  may  prefer  to  start  the  week's  menus  with 
Monday  rather  than  Sunday.  To  do  so,  rearrange  the  order  of 
the  days  in  line  90.  If  you  don't  like  some  of  the  foods  offered 
in  the  built-in  lists,  substitute  different  foods  of  your  own. 
This  is  done  by  editing  the  DATA  statements  that  contain  the 
names  of  dishes.  If  you  make  this  change,  be  sure  that  the  to- 
tal number  of  items  matches  the  values  in  lines  10-40.  These 
lines  contain  REMarks  to  indicate  which  category  they  control. 
For  example,  to  change  the  total  number  of  entrees  from  40  to 
45,  change  the  40  in  line  10  to  45.  A  more  significant  modifi- 
cation might  be  to  add  an  entirely  new  category — say,  a  sec- 
ond vegetable  dish  or  a  beverage. 

Menu  Planner 

Filename:  MENUP 

For  instructions  on  entering  this  program,  please  re/er  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

'   Copyright  1987  COMPUTE!  Publication*,  Inc. 4 

'   All  Rights  Reserved* 

4 

5  DEFINT  A -Z: SCREEN  lp  320,200,4,  la  WINDOW  3,  ,,M,  (0,0)  - 

(311, 186) , 16,1: WINDOW  OUTPUT  34 

10  NI (0>=40:REM  NUMBER  OF  ENTREES4 

20  NI(i)=20:REM  NUMBER  OF  VEGETABLES4 

30  N I (2) =20: REM  NUMBER  OF  STARCH/BREADS4 

40  NI (3) =20: REM  NUMBER  OF  DESSERTS4 

50  FOR  I  =  1  TO  17:EL*=EL*+CHR*<32):NEXT4 

60   T=0:FOR    I    =   0   TO   3:  IF  NI  <I )     >  T   THEN   T-NKD4 
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70  NEXT: DIM  MN*<3,T+1> ,SE*<3,7>4 

80  FOR  N  =  1  TO  7: READ  DA*<N):NEXT4 

90  DATA  SUNDAY , MONDAY , TUESDAY , WEDNESDAY  ,  THURSDAY  f  FR I 

DAY, SATURDAYS 

100  FOR  I  ■  0  TO  3:READ  TI*<  I)  :TI*<I>-THKI>«-Mi  "iNEX 

T4 

1 1 0  DATA  ENTREE , VEGETABLE , STARCH/BREAD , DE88ERT4 

120  FOR  I  -  0  TO  3iF0R  N  -  1  TO  NKDiREAD  MNt<I,N)i 

NEXT: MN*  < I , N>  =  "CHOICE" : NEXT4 

130  CH*="MRPSLEQ":GOTO  3504 

140  N=14 

150  RW=1:CL=14:GQSUB  900: PR I NT "MENU  PLANNER" 4 

160  RW=3:CL=0: GOSUB  910s PRINT  DA*(N)4 

170  RW=12:CL=11: GOSUB  910:PRINT"<C>  TO  CANCEL"4 

180  RW=13:G0SUB  910: PR I NT "< RETURN >  TO  SELECT "4 

190  RW=14:G0SUB  910: PR INT "< SPACE  BAR>  TO  CYCLE "4 

200  1=0: FOR  K  -  0  TO  3:SE*<K,N>="":NEXT4 

210  RW=5+I:CL=0: GOSUB  910: PRINT  TI*<I>4 

220  R=14 

230  RW=5+I:CL= 15: GOSUB  910: PRINT  MN*< I,R) jEL«4 

240  GOSUB  9304 

250    IF   A*OCHR*<13>    THEN   2804 

260  IF  R=NKI)+1  THEN  GOSUB  470:SE*<I,N>»IM*iGQTO  31 

04 

270  SE*<I,N)=MN*<I,R):60T0  3104 

280  IF  A*="C"  THEN  GOTO  1504 

290  IF  A*=CHR*<32>  THEN  R=R+1:IF  R>NMI>+1  THEN  2204 

300  GOTO  2304 

310  IF  SE*<0,N>="EAT  OUT"  THEN  3304 

320  1=1+1 i IF  I<4  THEN  2104 

330  IF  FL=1  THEN  FL=0:GOTO  3504 

340  N=N+1:IF  N<8  THEN  1504 

350  RW=1:CL=14: GOSUB  900: PR I NT "MENU  PLANNER "4 

360  RW=5:CL=9: GOSUB  910:PRINT"<M>AKE  A  MENU "4 

370  RW=6: GOSUB  910:PRINT"<R>EVIEW"4 

380  RW=7: GOSUB  910:PRINT"<P>RINT  0UT"4 

390  RW=8: GOSUB  910:PRINT"<S>AVE  CURRENT  MENU"4 

400  RW=9: GOSUB  910sPRINT"<L>QAD  OLD  MENU" 4 

410  RW=10:GOSUB  910:PRINT"<E>DIT"4 

420  RW=ll:GOSUB  910:PRINT"<Q>UIT"4 

430  RW=15:CL=6: GOSUB  9 10: PRINT "TYPE  LETTER  OF  YOUR  C 

H0ICE"4 

440  GOSUB  930:FOR  L  -  1  TO  7:  IF  A*OMID*<CH*,Lp  1)  TH 

EN  4504 

445  ON  L  GOTO  140,600, 600, 700,750, 500,8004 

450  NEXT4 

460  GOTO  4404 

470  GOSUB  920: RW=10:CL=0: GOSUB  910: INPUT "CHOICE "j IM* 

4 

480  IF  IM*=CHR*<32)  OR  IM*=""  THEN  4704 

490  R=46:RW=10:CL=0: GOSUB  910: PRINT  EL* j EL* I RETURN4 

500  RW=2:CL=5: GOSUB  900: INPUT "DAY  TO  EDIT"»DA*4 
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510  FOR  N  =  1  TO  7: IF  DA*=DA*(N)  THEN  FL=1:G0T0  1504 

520  NEXT:RW=4:CL=3:G0SUB  910: PR I NT "DAY  MUST  BE  SPELL 

ED  OUT  IN  FULL "4 

530  FOR  R  =  1  TO  2000: NEXT: GOTO  3504 

600  B*=A*:RW=0:CL=17:GQSUB  9004 

610  IF  B*="P"  THEN  OPEN  "LPT1:"  FOR  OUTPUT  AS  #lsPRI 

NT  #1,SPC(1S)  ELSE  OPEN  "SCRN: "  FOR  OUTPUT  AS  #14 

620  PRINT  #1,"MENU:":IF  B*="P"  THEN  PRINT  #1,SPC<43> 

"ON  HAND      NEED  TO  BUY "4 

630  FOR  N  =  1  TO  7: PRINT  #1 ,CHR* (13) : PRINT  #1,SPC(20 

-LEN (DA* (N) ) /2) ; DA* (N) : PRINT  #1 , CHR* ( 13) 4 

640   FOR    I    =   0   TO   3:  PRINT   #1 ,  SPC(4)  ;TI*  ( I)  ;  SPCU4-LEN 

<TI*(I)));SE*(I,N):NEXT4 

650  IF  B*="R"  AND  INKEY*=""  THEN  6504 

660  NEXT: CLOSE  #l:GOTO  3504 

700  RW=2:CL=3:GQSUB  900: INPUT  "NUMBER  OR  MENU  TO  SAV 

E";NO$:IF  NQ*=""  THEN  3504 

710  OPEN  "MENU" -HMO*  FOR  OUTPUT  AS  #14 

720  FOR  N=l  TO  7: FOR  1=0  TO  3: PRINT  #1 , SE* ( I,N> iNEXT 

I,N4 
730  CLOSE  #l:GOTO  3504 

750  RW=2:CL=3:G0SUB  900: INPUT  "NUMBER  OR  MENU  TO  LOA 
D";NO$:IF  NQ*=""  THEN  3504 
760  OPEN  "MENU"+NO*  FOR  INPUT  AS  #14 
770  FOR  N=l  TO  7: FOR  1=0  TO  3: INPUT  #1 , SE* ( I , N) a  NEXT 

I,N4 
780  CLOSE  #l:GOTO  3504 

800  WINDOW  CLOSE  3: SCREEN  CLOSE  1:END4 
900  CLS4 

910  LOCATE  RW+1,CL+1:RETURN4 
920  WHILE  INKEY*<>"":WEND:RETURN4 
930  A*=UCASE* ( INKEY*) : RETURN4 
1000  DATA  HOT  DOGS, HAMBURGERS, PORK  CHOPS, STEAK, ROAST 

BEEF, ROAST  PORK, LAMB  CH0PS4 
1010  DATA  VEAL  CUTLETS, ROAST  CHICKEN, FRIED  CHICKEN, C 
H I CKEN  SALAD , SP AGHETT I 4 
1020  DATA  LASAGNA,T ACQS, TUNA  PATTIES, TUNA  SALAD, TUNA 

NOODLE  CASSEROLE, BEEF  STEW4 
1030  DATA  TURKEY, POTATO  CHEESE  SOUP, COTTAGE  CHEESE, P 
EA  S0UP,0MELETTE4 

1 040  DATA  FETTUC INI, C ANNELLON I , MAN I COTT I , CREPES , SCRA 
MBLED  EGGS,BURRIT0S4 

1050  DATA  MEAT  LOAF, LEG  OF  LAMB, VEAL  SC ALOPP I NE , HAL I 
BUT , F I 3H , LOBSTER , CRAB4 

1060  DATA  CHOW  ME IN, CHOP  SUEY,BEEF  VEGETABLE  SOUP,EA 
T  GUT^ 

1099  REM  VEGETABLES: 4 

1100  DATA  CORN, FEAS, TOMATOES, GREEN  BEANS, SPINACH, GRE 
EN  SALAD, FRUIT  SALAD , CARR0TS4 

1110  DATA  BROCCOLI,CAULIFLOWER,SQUASH,ZUCCHINI,LETTU 
CE , CUCUMBER , P I CKLE , MUSHR00MS4 
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1120  DATA  CELERY, ONIONS, GREENS, LIMA  BEANS4 

119?  REM  STARCH/BREADS: 4 

1200  DATA  BREAD, FRIED  POTATOES, NOODLES, ROLLS, P I LAF,P 

ITA, KASHA, MATZOHS, CRACKERS* 

1210  DATA  SWEET  POTATOES, RICE, FRENCH  FRIES, MASHED  PO 

TATOES, BAKED  P0TAT04 

1220  DATA  BREAD  STICKS, GARLIC  BREAD, FRIED  RICE, BO I LE 

D  POTATOES , BUNS , PAST A4 

129?  REM  DESSERTS: 4 

1300  DATA  ICE  CREAM, POPS I CLE, CAKE, DOUGHNUT, FRUIT, CHE 

ESE  CAKE, COOKIES, PUDD I NG4 

1310  DATA  JELLO, SORBET, BROWNIES, FUDGE, FRUIT  PIE,CREA 

M  FIE, SWEET  R0LL,T0RTE4 

1320  DATA  B0M3E, BAKED  ALASKA, DRIED  FRUIT, JELLY  R0LL4 

4 
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Weather  Wizard 

John  R.  Wetsch 
Translation  by  BiJJ  Chin 

This  weather-forecasting  program  is  written  entirely 
in  BASIC.  Originally  a  generic  program  for  a  multi- 
tude of  microcomputers,  this  version  was  created  es- 
pecially for  the  Amiga.  Stay  current  on  the  most 
popular  subject  in  the  world  with  your  own  personal 
"Weather  Wizard." 


"Weather  Wizard"  is  a  simple,  easily  modified  BASIC  program 
for  forecasting  the  weather.  It  uses  a  questionnaire  format  to 
get  the  data  needed  to  predict  the  weather.  You  provide  the 
information,  and  Weather  Wizard  automatically  does  the  rest. 
Type  in  the  accompanyimg  listing  and  save  a  copy  before  you 
run  it. 

Entering  Data 

Weather  Wizard  is  largely  self-prompting,  so  you  will  not 
need  extensive  instructions  to  use  it.  The  program  begins  by 
asking  you  to  enter  several  items  of  information  about  current 
weather  conditions,  beginning  with  the  current  month,  day, 
and  year.  Enter  a  number  from  1  to  12  for  the  month,  a  num- 
ber from  1  to  31  for  the  day,  and  so  on. 

The  program  then  displays  instructions  for  entering  the 
next  item  of  information,  the  wind  direction.  This  is  done  by 
typing  a  number  according  to  the  categories  shown  on  the 
screen. 

Next,  you  must  enter  the  current  barometric  pressure,  ex- 
pressed in  inches  of  mercury.  This  will  be  a  number  in  the 
range  27-33. 

After  the  barometric  pressure,  you  must  enter  the  baro- 
metric activity  (whether  the  barometer  is  steady,  rising  fast, 
and  so  forth).  Again,  the  computer  displays  a  menu  indicating 
which  number  to  type. 
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The  next  item  of  information  is  the  prevailing  cloud  type. 
As  prompted  by  the  computer,  enter  a  1  for  cirrus  clouds,  a  2 
for  cumulus,  and  so  on.  If  you  are  not  familiar  with  the  vari- 
ous cloud  types,  refer  to  the  brief  explanations  which  follow. 

Finally,  enter  the  current  humidity  and  temperature  when 
prompted.  When  you  are  finished  entering  data,  the  computer 
prints  a  complete  forecast  for  a  6-  to  36-hour  period.  The  pe- 
riod of  the  forecast  depends  on  what  sort  of  weather  is  ex- 
pected. To  calculate  another  forecast,  answer  Y  at  the  final 
prompt. 

Cloud  Types 

Cumulus  clouds  are  puffy,  white,  and  cottonlike  in  appearance 
with  a  clearly  defined  outline.  Perhaps  the  most  familiar  cloud 
type,  these  are  usually  found  at  lower  altitudes,  with  cloud 
tops  seldom  exceeding  5000  feet. 

Altocumulus  clouds  are  small,  semitransparent,  cumulus- 
type  cloudlets  that  appear  in  layers.  This  type  of  cloud  evolves 
from  the  lifting  of  lower  clouds.  They  often  appear  connected, 
and  you  can  see  the  sky  through  them.  Rounded  and  regularly 
arranged,  they  are  usually  found  at  an  altitude  of  10,000- 
17,000  feet. 

When  a  cumulus  cloud  develops  both  extreme  height  and 
mass,  it  evolves  into  a  cumulonimbus  cloud.  Although  it  makes 
up  the  most  beautiful  cloud  mass,  sweeping  up  into  a  tower- 
ing column,  these  are  the  most  dangerous  clouds.  Capable  of 
producing  heavy  rain,  hail,  lightning,  and  strong,  gusty  winds, 
they  occasionally  mask  a  tornado.  These  clouds  may  be  easily 
identified  by  their  massive  appearance,  vertical  development 
(often  in  excess  of  20,000  feet),  anvil-shaped  top,  and  thunder 
and  lightning.  Occasionally  the  tops  of  extremely  powerful  cu- 
mulonimbus clouds  will  exceed  30,000  feet. 

Stratus  clouds  are  gray,  featureless  sheets,  sometimes  lay- 
ered in  appearance.  This  type  of  cloud  produces  only  light 
precipitation,  if  any,  and  may  reveal  the  sun  through  its  thin- 
nest parts.  When  in  contact  with  the  earth  (at  an  altitude  of  50 
feet  or  less)  this  cloud  type  is  called  fog.  The  tops  of  stratus 
clouds  rarely  exceed  10,000  feet,  although  one  variety,  nimbo- 
stratus,  may  have  cloud  tops  reaching  to  15,000  feet. 
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The  word  nimbus  is  a  Latin  word  meaning  violent  rain  or 
black  rain  cloud.  Nimbostratus  clouds  produce  continous  pre- 
cipitation. This  cloud  type  is  often  gray  and  is  always  thick 
enough  to  obscure  the  sun.  Nimbostratus  clouds  are  usually 
found  near  weather  fronts,  and  although  classified  as  a  middle- 
altitude  cloud,  with  tops  ranging  to  15,000  feet,  the  cloud  base 
may  be  quite  low. 

Altostratus  clouds  are  a  smooth,  uniform,  gray  sheet  of 
cloud  cover,  and  consist  mostly  of  ice  crystals,  although  the 
lowest  portion  may  be  water  droplets.  The  sun  may  appear  as 
though  seen  through  ground  glass,  and  objects  on  the  ground 
will  not  cast  a  shadow.  Any  precipitation  associated  with  this 
cloud  type  is  continous.  Altostratus  clouds  are  considered 
middle-level  clouds,  and  generally  occur  between  6500  and 
23,000  feet  in  altitude. 

Cirrostratus  clouds  are  thin,  white  clouds  that  appear  in 
sheets.  The  sun  and  moon  are  hardly  ever  obscured  by  these 
clouds,  which  often  indicate  severe  weather  to  come.  They  are 
typically  found  high  in  the  atmosphere,  usually  above  25,000 
feet. 

Cirrus  clouds  are  wispy  and  white,  generally  occurring  be- 
tween 16,500  feet  and  45,000  feet.  A  buildup  of  cirrus  clouds 
may  indicate  an  approaching  warm  front. 

Weather  Wizard 

Filename:  WEATHERWIZ 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTETs  Guide  to  Typing  In  Amiga  Programs." 

5  SCREEN  1,320,200,4,1: WINDOW  3, " " , (0, 0) - (31 1 , 186) , 1 
6,1: WINDOW  OUTPUT  34 

10  REM  Copyright  1987  COMPUTE!  Publications,  Inc.   A 

11  rights  reserved* 
20  GOSUB  15204 

30  PRINT  "The  Weather  Wizard" 4 

40  PRINT  4 

50  PRINT  "Copyright  1987  COMPUTE!  Publ i cations" : PRIN 

T"A11  rights  reserved"* 

60  FOR  j=l  TO  3000: NEXT  j4 

70  GOSUB  15204 

80  PRINT  "Enter  month  (use  number )"; : min=l : max=12: GO 

SUB  1390: m  ■  e4 

90  PRINT  "Enter  day" ;: mi n»l : max=31 : GOSUB  1390: d  =  e4 

100  PRINT  "Enter  the  year ";: mi n=0: max =2 100: GOSUB  139 
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0:y  *  e4 

110  GOSUB  15204 

120  PRINT"Please  input  numbers  when  prompted  by  ?"4 

130  PRINT  4 

140  PRINT  "  From  the  menu  enter  the  number  corres-"4 

150  PRINT"ponding  to  the  wind  direction"4 

160  PRINT  4 

170  PRINT  "N«  North,  S-  South,  E=  East,  W»  West "4 

180  PRINT  "(Note:  The  directions  are  where  the"4 

190  PRINT  "wind  comes  from,  not  where  it  is  going-"4 

200  PRINT  "So,  'NE'  means  a  wind  blowing  out  of"4 

210  PRINT  "the  northeast- ) "4 

220  PRINT  4 

230  PRINT  " WIND  DIRECTION  MENU "4 

240  PRINT  4 

250  PRINT  "1-  N"SPC(4)"2.  NE"SPC (3) "3-  E"4 

260  PRINT  4 

270  PRINT  "4-  SE"SPC(3)"5.  S"SPC(4)"6.  SW"4 

280  PRINT  4 

290  PRINT  "7-  W"SPC(4) "8.  NW'SPC (3) "9-  No  wind"4 

300  PRINT  4 

310  PRINT4 

320  min=l:max=9:G0SUB  1390:w  *  e4 

330  GOSUB  15204 

340  PRINT  "Enter  barometric  pressure": PRINT  "in  inch 

es  of  Hg  (ex-  29-95)  ";4 

350  min»27x max -33: GOSUB  1480: bp  *  e4 

360  GOSUB  1520  4 

370  PRINT  "Please  enter  the  number  that  describes"4 

380  PRINT  "current  barometric  activity. "4 

390  PRINT  "Barometer  is:  1-  steady "4 

400  PRINT   SPC(14)"2-  rising  fast"4 

410  PRINT   SPC(14)"3.  slowly  rising"4 

420  PRINT   SPC(14)"4-  falling  fast"4 

430  PRINT   SPC(14)"5.  slowly  falling"4 

440  PRINT  4 

450  mi n-1: max -5: GOSUB  1390: bd  «e4 

460  GOSUB  15204 

470  PRINT   "Please  enter  the  number  for  the  main"4 

480  PRINT   "cloud  type  for  your  location."4 

490  PRINT  4 

500  PRINT  "1-  Cirrus": PRINT  "2.  Cumulonimbus" : PRINT 

"3-  Stratus"  4 

510  PRINT  "4-  Nimbostratus": PRINT  "5-  Al tostratus":  P 

RINT  "6.  Altocumulus"4 

520  PRINT  "7.  Cirrostratus": PRINT  "8-  Cumulus": PRINT 

"9.  No  clouds": PRINT  4 
530  mi n-1: max -9: GOSUB  1390:c  -  e4 
540  GOSUB  15204 

550  PRINT  "Input  Humidity": PRINT  "(ex-  input  50  for 
50%  humidity) ";4 
560  min-0:  max -100:  GOSUB  1480:  h  -  e4 
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570  BOSUB  15204 

580  PRINT  "Input  Temperature  in  Fahrenheit" : PRINT" (e 

x-  63  =  63  deg.  F)";4 

590  mi n«- 130: max =130: BOSUB  1480: t  =  e4 

600  BOSUB  15204 

610  REM  forecasts* 

620  IF  bp  >29.9  THEN  7104 

630  IF  (w>-l  AND  w<-5)  AND  bd-4  AND  bp>29.7  THEN  860 

4 

640  IF  (w>-6  AND  w<=8>  AND  (bd>»l  AND  bd<=3)  AND  t>7 

5  AND  h>68  THEN  9104 

650  IF  (w>=6  AND  w<=8>  AND  (bd=2  OR  bd=3)  THEN  9304 

660  IF  bp>29.7  THEN  8104 

670  IF  (bd«2  OR  bd*3)  THEN  10404 

680  IF  <w>=l  AND  w<=5)  AND  bd=4  THEN  11104 

690  IF  <w=2  OR  w=3)  AND  bd=5  THEN  11204 

700   60T0  8104 

710  IF  <w>-=6  AND  w<=8)  AND  (bd=l  OR  bd=3)  AND  t>75  A 

ND  h>70  THEN  9504 

720  IF  <w>«6  AND  w<=8)  AND  (bd=l  OR  bd=3)  THEN  9704 

730  IF  w»4  AND  bd=5  THEN  10004 

740  IF  w=4  AND  bp>30.5  AND  (bd=4  OR  bd=5)  THEN  10204 

750  IF  (w=4  OR  w=5)  AND  bd=4  THEN  10604 

760  IF  (w=4  OR  w=5)  AND  bd=5  THEN  10804 

770  IF  <w=3  OR  w=4)  AND  bd=4  THEN  10904 

780  IF  w-5  AND  (bd=4  OR  bd*5)  THEN  8604 

790  IF  (w»l  OR  w=2)  AND  bd=4  THEN  11404 

800  IF  <w=l  OR  w=2)  AND  bd=5  THEN  11604 

810  ON  c  BOTO  1180,  1210,  1260,  1280,  1300,  820,  131 

0,  840,  8404 

820  IF  t>75  AND  h>68  THEN  9504 

830   BOTO  13104 

840  IF  t>75  AND  h>68  THEN  13304 

850  BOTO  13404 

860  PRINT  "FORECAST:  STRONB  WINDS  and  HEAVY "4 

870  PRINT  "PRECIPITATION  CAN  BE  EXPECTED  within"4 

880  PRINT  "the  next  6-24  hours.   Lower  tempera-"4 

890  PRINT  "tures  are  also  forecast. "4 

900  BOTO  15304 

910  PR I NT "C SMALL  CHANCE  OF  THUNDERSTORMS  TODAY 3" 4 

920  PRINT  4 

930  PRINT  "FORECAST:  FAIR  weather  can  be  expected"4 

940  PRINT  "for  the  next  24  to  36  hours.": GOTO  15304 

950  PRINT  "C SLIGHT  CHANCE  OF  THUNDERSTORMS  TODAY D" 4 

960  PRINT  4 

970  PRINT  "FORECAST:  continued  FAIR  weather  for "4 

980  PRINT  "the  next  24  hours.   Temperatures  wi  11**4 

990  PRINT  "remain  nearly  constant .": GOTO  15304 

1000  PRINT  "FORECAST:  PRECIPITATION  can  be  expected 
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1010  PRINT   "in  24-48  hours. " :GOTO  15304 

1020  PRINT  "FORECAST:  WARMER  temperatures  for  the"4 

1030  PRINT  "next  24  hours. ": GOTO  15304 

1040  PRINT  "FORECAST:  Clear  weather  ahead  with" 4 

1050  PRINT  "cooler  temperatures. ": GOTO  15304 

1060  PRINT  "FORECAST:  HIGH  WINDS  and  PRECIPITATI0N"4 

1070  PRINT  "within  12  hours. ": GOTO  15304 

1080  PRINT  "FORECAST:  PRECIPITATION  within  24  hours. 

":GOTO  15304 

1090  PRINT  "FORECAST:  HIGH  WINDS  and  PRECIPITATIONS 

1100  PRINT  "within  24  hours. ":GOTO  15304 

1110  PRINT  "FORECAST:  SEVERE  weather;  stormy  with":P 

RINT  "high  winds. ":GOTO  15304 

1120  PRINT  "FORECAST:  continuing  precipitation  can"4 

1130  PRINT  "be  expected  for  the  next  12  to  24  hours. 

":GOTO  15304 

1140  PRINT  "FORECAST:  STORMS  with  HIGH  WINDS  within" 

4 

1150  PRINT  "24  hours.   Cooler  temperatures  as  well." 

:GOTO  15304 

1160  PRINT  "FORECAST:  Precipitation  within  24-36"4 

1170  PRINT  "hours,  slightly  cooler  temperatures. ": GO 

TO  15304 

1180  PRINT  "FORECAST:  If  cirrus  clouds  are"4 

1190  PRINT  "increasing  and  becoming  more  dominant "4 

1200  PRINT  "we  can  expect  warmer  weather .": GOTO  1530 

4 

1210  PRINT  "FORECAST:  50-807.  chance  of  preci-"4 

1220  PRINT  "pitation  within  the  next  24-36  hours. "4 

1230  PRINT  "Chance  of  precipitation  will  increased 

1240  PRINT  "with  the  accumulation  of  more  cumulo-"4 

1250  PRINT  "nimbus  type  clouds. ": GOTO  15304 

1260  PRINT  "FORECAST:  10-207.  chance  of  ";:IF  t>35  TH 

EN  PRINT  "showers": GOTO  15304 

1270  PRINT  "snow  flurries": GOTO  15304 

1280  PRINT  "FORECAST:  907.  chance  of  HEAVY  precipi-"4 

1290  PRINT   "tation  within  12-24  hours. ": GOTO  15304 

1300  PRINT  "FORECAST:  Chance  of  light  precipitation. 

":GOTO  15304 

1310  PRINT  "FORECAST:  PRECIPITATION  with  HEAVY"4 

1320  PRINT  "winds  in  24-48  hours. ": GOTO  15304 

1330  PRINT  "C POSSIBILITY  OF  THUNDERSTORMS  TODAY] "4 

1340  PRINT  "FORECAST:  FAIR  weather  today  with  light" 

4 

1350  PRINT  "to  moderate  winds. ": GOTO  15304 

1360  REM  integer  input  routine4 

1370  PRINT  "enter  an  integer  between" ; mi n; "  and  ";ma 

x4 

1380  PRINT  ",  try  again" 4 

1390  e*="": INPUT  e*:e  -  VAL  (e*)4 

1400  IF  e=0  AND  LEFT* <e*, 1 ) <>"0"  THEN  13704 

1410  IF  eOINT(e)  THEN  PRINT  "please  enter  an  intege 
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r";:GOTO  13804 

1420  IF  min>e  THEN  PRINT  "too  low";:GOTO  13804 

1430  IF  e>max  THEN  PRINT  "too  high";: GOTO  13804 

1440  RETURN4 

1450  REM  real  number  input  routine4 

1460  PRINT   "enter  a  number  between" ; mi n"  and  ";max4 

1470  PRINT  ",  try  again"4 

1480  e*="": INPUT  e*:e  ■  VAL  <e*> : IF  e=0  AND  LEFTSCe* 

,1)<>"0"  THEN  14604 

1490  IF  min>e  THEN  PRINT  "too  low";:GOTO  14704 

1500  IF  e>max  THEN  PRINT  "too  high";:GOTO  14704 

1510  RETURN4 

1520  CLS:RETURN4 

1530  PRINT  :PRINT  m; "/"; d; "/"; y: PRINT  4 

1540  PRINT  "Temperature  is: " ; t ; "deg.  F":PRINT  4 

1550  PRINT  "Humidity  is:  ";  h;  "7." :  PRINT  4 

1560  PRINT  "Barometric  pressure  is:  ";bp;"  in.  Hg"  4 

1570  FOR  j=l  TO  3500: NEXT  j4 

1580  PRINT  : PRINT  : PRINT  : PRINT  : PRINT  4 

1590  PRINT  "press  <RETURN>  to  make  another  forecast" 

4 

1600  INPUT  p*4 

1610  GOSUB  15204 

1620  GOTO  1204 


4 
4 
4 
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Graphics 


GraphiDemo 


Stefan  Lindahl 


This  intriguing  graphics  program,  written  by  a  COM- 
PUTE! magazine  reader  in  Sweden,  demonstrates  the 
Amiga's  tremendous  graphics  processing  power  as 
well  as  the  speed  of  Amiga  Basic.  The  program  re- 
quires 51 2K  of  memory. 


"GraphiDemo"  demonstrates  just  how  easy  it  is  to  create  im- 
pressive graphics  in  Amiga  Basic.  Type  it  in  and  save  a  copy 
of  the  program;  then  run  it.  GraphiDemo  begins  by  displaying 
a  help  screen  that  explains  all  of  the  program's  options.  You 
can  recall  this  screen  at  any  time  by  pressing  the  Help  key. 
Take  a  moment  to  look  at  all  the  different  options;  you'll  want 
to  try  them  all. 

GraphiDemo's  options  can  be  invoked  in  two  different 
ways.  If  you  press  the  right  mouse  button  and  examine  the 
menus  at  the  top  of  the  screen,  you'll  see  that  every  option 
can  be  selected  from  a  menu,  using  the  mouse  pointer.  How- 
ever, GraphiDemo  uses  all  of  the  Amiga's  colors,  which  can 
make  the  menus  unreadable  at  times.  Thus,  you  can  also  se- 
lect any  option  by  pressing  the  key  indicated  in  the  help 
screen.  If  you  forget  which  key  is  assigned  to  which  option, 
simply  press  Help.  When  you  exit  the  help  screen,  the  main 
screen  is  restored  to  its  original  condition. 

Since  the  program  is  entirely  self-prompting,  no  elaborate 
explanations  are  necessary.  Just  run  it,  follow  the  prompts, 
and  enjoy  the  show.  If  you're  interested  in  graphics  program- 
ming, the  program  provides  examples  of  how  to  draw  differ- 
ent shapes  and  control  the  color  palette  for  various  effects. 
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GraphiDemo 

Filename:  GRAPHIDEMO 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEVs  Guide  to  Typing  In  Amiga  Programs." 

REM  **  Copyright  1987  Compute!  Publications,  Inc.   * 

*4 

REM  **  All  Rights  Reserved  **4 

4 

CLEAR  ,13000         :REM  *  Release  basic  memory  to  s 

ystem  *4 

DEFINT  b-y  : REM  *  Integer  definition  *4 

4 

RANDOMIZE  TIMER      : REM  *  New  random  seed  *4 

4 

b=5  :REM  *  Maximum  step  length  *4 

cm=0  :REM  *  Circlemode  off  *4 

depth=4  :REM  *  No  of  bitlayers  *4 

4 

SCREEN  2 , 640 , 200 , depth , 24 

WINDOW  2, , , 16,24 

maxcoLor=2^depth-14 

4 

GOSUB  SetcoL4 

4 

GOSUB  CLrmenu4 

4 

ch=2:ch2temp=3: GOSUB  10: GOSUB  20   : REM  *  Set  menus  & 

check  marks  *4 
4 

ON  MENU  GOSUB  Mnuche4 
MENU  0N4 
4 

ON  MOUSE  GOSUB  Chkmus4 
MOUSE  0N4 
4 

GOSUB  Info        :REM  *  Display  info-window  *4 
4 

VarvaL:4 

x  1=50+RND*540:  y  1=50+RND*  120:  x2=50+RND*540:  y2=50+RND* 
1204 

IF  x2<xl  OR  y2<yl  THEN  VarvaL4 

xsl= ( l+RND*b> : xs2= < l+RND*b) : ysl= ( l+RND*b  > : ys2» ( 1+RND 
*b>4 

mi  nx  =0 : max  x  *629 : mi  ny=0 : max  y= 1 954 
4 

Main: 4 

FOR  doit«*-l  TO  1  STEP  24 
4 

FOR  cc=maxcoLor*-<doit=-l)  TO  maxcoLor*-(doitaBl)  S 
TEP  doit4 
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oLdxl«xl:oLdyl=yl:xl*xl+xsl:yl=yl+ysl4 
GLdx2-^x2:oLdy2«y2:x2»x2+xs2iy2=y2+ys24 
4 

IF  xKminx  OR  xl>maxx  THEN  x  l=xl-xsl  :xsl  =  (1+RND* 
b)*-SGN(xsl>4 

IF  x2<minx  OR  x2>rnaxx  THEN  x2=x2-xs2:xs2= (1+RND* 
b)*-SGN(xs2>4 

IF  yKminy  OR  yl>maxy  THEN  yl-yl-ysl :  ysl  =  (1+RND* 
b)*-SGN(ysl>4 

IF  y2<miny  OR  y2>maxy  THEN  y2=y2-ys2:ys2= (1+RND* 
b)*-SGN(ys2>4 

key-ASC(INKEY*+CHR*(0)>:IF  key  THEN  GOSUB  Keyche 
4 

ON  choice  GOSUB  Serpent, Lines, Boxes, Fi 11 edboxes4 
NEXT  cc4 
NEXT  doit4 

4 
GOTO  Main     4 
4 
Serpent: 4 

COLOR  cc:IF  cm  THEN4 

GOSUB  CircLepos: AREA  STEP  (0,0): AREA  (xl,yl):A 
REA  (x2,y2)4 

AREAFILL4 
ELSE4 

AREA  (xl,yl):AREA  (oLdx 1 , oLdyl ) : AREA  (x2,y2):A 
REA  (oLdx2,oLdy2)4 
AREAFILL4 

AREA  (xl,yl):AREA  (x2,y2):AREA  (oLdxl , oLdyl )  :  A 
REA  (oLdx2,oLdy2)4 
AREAFILL4 
END  IF4 
RETURN4 
4 
Lines: 4 

IF  cm  THEN  GOSUB  CircLepos  ELSE  PSET  (xl,yl),cc4 
LINE  -(x2,y2),cc4 
RETURN4 
4 
Box  es : 4 

IF  cm  THEN  GOSUB  CircLepos  ELSE  PSET  (xl,yl),cc4 
LINE  -(x2,y2),cc,b4 
RETURN4 
4 
Filledboxes:4 

IF  cm  THEN  GOSUB  CircLepos  ELSE  PSET  (xl,yl),cc4 
LINE  -(x2,y2),cc,bf4 
RETURN4 
4 
CircLemode:4 

CLS:cm=ABS(cm-l)4 
RETURN4 
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CircLepos:4 

api«api+.05:PSET  <314+200*SIN(api ) , 90+70*COS (api 
>),cc4 
RETURN* 
4 
Mnuche:4 

IF  MENU (0) =2  THEN  menu2      : REM  *  Menu  1  or  2  ? 
4 
menu 1:4 

ch«MENU (1)4 

IF  ch>4  THEN  ON  ch-4  BOTO  SetcoL, Inf o, Resetprog4 
10   QOSUB  Setmenu4 

choi ce«ch: MENU  1, choice, 24 

RETURN4 
menu2:4 

ch2temp=MENU(l)4 

20  IF  ch2=ch2temp  THEN  RETURN  ELSE  ch2=ch2temp4 

21  BOSUB  menuNo2:MENU  2,ch2,24 
SOTO  SetcoL4 

4 
Keyche:  4 

IF  key=27  THEN  Resetprog  : REM  *  Esc 

key  *4 

IF  key=139  THEN  Info 
key  *4 

IF  key»133  THEN  SetcoL 
key  *4 

IF  key«127  THEN  CLS 
key  *4 

IF  (key  AND  223) =67  THEN  CircLemode 
key  *4 

IF  key>133  AND  key<137  THEN  coLormode4 

IF  key<129  OR   key > 132  THEN  RETURN  4 

ch»key-128:60T0  10 
coLormode: 4 

ch2temp»key-133:60T0  20 
RETURN4 


:REM  *  Help 

sREM  *  F5 

[REM  *  Del 

:REM  *  »C 


:REM  *  Fl  -  F4  *4 
:REM  *  F6  -  F8  *4 


Set menu: 4 

MENU  1,0,1, 

Main:"4 

MENU  1,1,1, 

Serpent      "4 

MENU  1,2,1, 

Lines        M4 

MENU  1,3,1, 

Boxes        "4 

MENU  1,4,1, 

Filledboxes  "4 

MENU  1,5,1, 

New  Colors   "4 

MENU  1,6,1, 

Help         "4 

MENU  1,7,1, 

"    Stop  program"4 

RETURN4 
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Col  or Opt ions: "4 
RGB  <->  BLACK  shading "4 
Random  color  shading  "4 
Random  colors         "4 


Clear  standard  menus4 


menuNo2:4 

MENU  2,0, 1," 

MENU  2,1,1," 

MENU  2,2,1," 

MENU  2,3,1," 
RETURN  4 
4 
CLrmenu:4 

MENU  1,0,0, ""4 

MENU  2, 0,0," "4 

MENU  3,0,0,"" 

MENU  4,0,0, ""4 
RETURN4 

4 
S«tcoL:4 

ON  ch2  SOTO  SetcoLl,SetcoL2,SetcoL34 
4 
SetcoLls4 

CLS4 

c»RND*7+.5  4 

cl»SBN<c  AND 

c2-SQN(c  AND 

c3-S6N(c  AND  4)    4 

FOR  c-0  TO  maxcoLor4 

PALETTE  c, <c/16)*cl, (c/16)*c2, (c/16)*c34 

NEXT  c4 

RETURN4 


1)4 
2)4 


S»tcoL2s4 

CLS4 

FOR  w-1 

FOR  w«=l 
NEXT  w4 

4 

FOR  w-0 


TO  3:al<w)»RND:a2(w)-RND:NEXT  w4 

TO  3: adeL (w) = (a2 (w) -al <w> ) / (maxcoLor+1 ) : 


TO  maxcoLor4 
PALETTE  w,al(l),al(2),al(3)4 

FOR  wl-1  TO  3:al(wl)-al(wl)+adeL(wl):NEXT  wl4 
NEXT  w4 
RETURN   4 


S«tcoL3:4 

FOR  c*0  TO  maxcoLor4 

PALETTE  c,RND,RND,RND4 
NEXT  c4 
RETURN4 
4 
4 
Ras»tprogs4 

MENU  RESET4 

PALETTE  0, . 4375, . 125, -  18754 

PALETTE  1,1,. 56, 04 
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PALETTE   2,1,-1,-64 

PALETTE   3,-44,-6,-944 

WINDOW  CLOSE  24 

SCREEN  CLOSE  24 

CLS4 

END4 
4 
Chkmus:4 

IF  inf  THEN  inf=0  ELSE  CLS4 
RETURN4 
4 
Info:4 

MENU  STOP: inf-ls REM*  To  tell  mouse-trapping  rout 
ine  4 

WINDOW  3,, (100, 10) -(517, 175), 0,2   : REM  that  we'r 
e  in  Info4 

CLS: COLOR  maxcoLor-24 

PRINT  SPACE*(5); "Copyright  1987  Compute!  Publica 
tions,  Inc-"4 

PRINT  SPACE* ( 16) ;"A11  Rights  Reserved": PR I NT4 

PR I NT  SPACE* ( 20 ) ; " GRAPH I DEMO " 4 

PRINT  SPACE*  (8) ;  "Fl  or  Menu Se 

rpent"4 

PRINT  SPACE* (8) ; "F2  or  Menu  

LinesH4 

PRINT  SPACE* (8) ; "F3  or  Menu  

Boxes "4 

PRINT  SPACE*(8);"F4  or  Menu Filled 

boxes "4 

PRINT  SPACE*  (8) ;  "F5  or  Menu New  C 

olors"4 

PRINT  : PRINT  SPACE* (8) ; "F6  or  Menu  -.-  RGB  <->  B 
LACK  shading" 4 

PRINT  SPACE*(8);"F7  or  Menu  Random  color  sh 

ading"4 

PRINT  SPACE*(8);"F8  or  Menu Random  c 

olors"4 

PRINT  SPACE*(8);"'C  key toggle  'Circle 

mode' "4 

PRINT: PRINT  "Clear  Screen  with  Left  Mouse  button 
or  the  DEL  key- "4 

PRINT  "   Stop  the  Program  with  the  ESC  key  or  fr 
om  Menu. "4 

PRINT: PRINT  "Get  this  window  back  with  the  HELP 
key  or  from  Menu. "4 

PRINT: PRINT  SPACE* ( 14) ; "PRESS  ANY  KEY  TO  CONTINU 
Eu;4 
Waithere:4 
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IF  INKEY*«"M  AND  inf«l  THEN  Wai there    :REM  *  Ch 
•ck  for  key  or   * 

WINDOW  CLOSE  3  : REM  *  mo 

umebutton4 

MENU  ON    « 
RETURN* 

4 
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Fractal  Mountains 

Matthew  Timmerman 

With  this  landscape-generating  program  and  a  512K 

Amiga  computer,  you  can  create  fascinating  graphics 

displays  based  on  the  principles  of  fractal  geometry. 

"Fractal  Mountains"  is  an  intriguing  graphics  program  that 
draws  landscapelike  scenes  containing  rough,  crinkled-looking 
mountain  shapes.  Although  you  can  run  it  and  simply  enjoy 
the  pictures  it  creates,  the  program  is  based  on  highly  ad- 
vanced mathematical  concepts  which  you  may  wish  to  learn 
more  about.  Type  in  the  program  and  save  a  copy  before  you 
run  it. 

When  you  run  Fractal  Mountains,  it  asks  you  to  enter  a 
number  for  the  random  seed.  This  value  determines  which 
landscape  the  program  generates.  There  are  65,536  possible 
landscapes,  so  you  needn't  repeat  a  landscape  very  often  un- 
less you  find  one  you  particularly  like.  Enter  a  number  in  the 
range  indicated  by  the  onscreen  prompt.  (The  first  time  you 
run  the  program,  try  entering  70  for  the  random  seed.) 

The  second  prompt  asks  you  to  enter  a  number  for  the 
maximum  variation.  This  value  determines  the  cragginess  of 
the  mountains.  Although  the  program  prompts  you  to  enter  a 
value  in  the  range  0-2,  you  aren't  necessarily  limited  to  that 
range.  A  variation  of  0  gives  you  a  perfectly  flat  plane  (no 
variation),  while  a  value  of  2  gives  you  extremely  high,  rugged 
mountain  peaks.  (The  first  time  you  run  the  program,  try  en- 
tering 1.96  for  the  maximum  variation.) 

After  you've  entered  those  values,  the  program  draws  the 
landscape.  Please  be  patient  while  the  process  is  underway. 
Although  Amiga  Basic  is  one  of  the  fastest  microcomputer  BA- 
SICS, it  still  takes  considerable  time  to  perform  the  tens  of 
thousands  of  calculations  this  program  requires. 

Once  the  picture  is  complete,  you  can  save  the  picture  to 
disk  by  pressing  the  S  key.  To  show  you  what  is  happening, 


172 


Graphics 


the  program  draws  a  white  line  on  the  screen  indicating  which 
line  of  the  picture  it  is  saving.  The  picture  is  saved  in  ILBM 
(Interleaved  BitMap)  format,  which  allows  you  to  load  it  into 
Deluxe  Paint,  Graphicraft,  and  other  IFF-compatible  art  pro- 
grams. To  exit  the  program,  press  the  space  bar. 

If  you  find  a  mountain  that  you  like,  but  it  is  too  smooth, 
use  the  same  random  seed  value  with  a  higher  maximum  vari- 
ation. If  you  get  a  landscape  which  is  mostly  water,  try  it 
again  using  a  negative  maximum  variation.  The  negative  value 
inverts  the  landscape:  What  was  once  land  becomes  water, 
and  vice  versa.  Since  gravity  is  meaningless  in  this  universe, 
pictures  look  as  good  upside  down  as  they  do  right  side  up. 
Don't  be  afraid  to  experiment  with  different  values.  Not  all 
combinations  give  pleasing  results,  but  exploration  is  one  of 
the  interesting  aspects  of  using  a  program  like  this. 

Why  Fractals? 

A  fractal  is  an  object  with  a  fractional  dimension — a  value  be- 
tween 1  and  2,  for  instance,  or  between  2  and  3.  In  his  book 
The  Fractal  Geometry  of  Nature,  Benoit  Mandelbrot  tells  us  to 
imagine  a  piece  of  aluminum  foil.  When  it's  flat,  it  is  a  simple 
plane  with  two  dimensions.  As  you  begin  to  crinkle  the  foil,  it 
can  no  longer  be  confined  to  two  dimensions,  but  it  is  not  yet 
three-dimensional.  Therefore,  it  has  a  dimension  somewhere  2 
and  3.  The  aluminum  foil  becomes  more  crinkled  until,  even- 
tually, it  becomes  a  solid  block  filling  three  dimensions. 

The  same  analogy  can  be  applied  to  a  straight  line  becom- 
ing bent  until  it  becomes  infinitely  bent  and  complex,  com- 
pletely darkening  the  surface  on  which  it  is  drawn.  At  that 
point,  the  line  is  no  longer  a  line,  but  a  two-dimensional 
plane. 

Another  aspect  of  fractals  is  self-similarity,  meaning  that 
the  big  parts  of  the  object  look  like  the  little  parts.  To  take  a 
rough  example,  if  you  break  a  chunk  of  rock  from  a  mountain, 
the  rock  looks  like  a  miniature  mountain.  It's  not  the  same,  but 
it  has  the  same  general  look.  This  phenomenon  occurs 
throughout  nature:  in  tree  bark,  snowflakes,  coastlines  of  con- 
tinents, trees,  clouds,  surfaces  of  proteins,  all  types  of  turbu- 
lence, and  the  positioning  of  stars,  planets,  solar  systems,  and 
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galaxies — all  of  which  are  only  a  few  of  the  countless 
possibilities. 

The  algorithm  used  to  create  these  pictures  is  derived 
from  one  described  in  the  September  1984  issue  of  Scientific 
American.  However,  whereas  that  formula  was  based  on  a  tri- 
angle, this  one  is  based  on  a  square  (for  display  purposes). 

To  understand  how  the  program  works,  imagine  that  you 
begin  with  a  square,  putting  a  point  in  the  center  of  all  four 
sides  of  the  shape.  Next,  raise  or  lower  those  points  a  random 
amount,  as  much  as  half  the  length  of  the  square.  At  that 
point,  you  put  a  point  in  the  center  of  the  square  and  give  it 
the  average  height  of  all  the  corners.  Raise  or  lower  this  point 
by  a  random  amount,  using  the  same  conditions  as  in  the  pre- 
vious adjustment,  and  connect  the  points. 

You  now  have  four  smaller  squares.  By  repeating  this  pro- 
cess, you  obtain  smaller  and  smaller  squares,  eventually  ob- 
taining a  good  approximation  of  a  natural  landscape  surface. 

The  most  difficult  part  of  making  a  convincing  mountain 
is  putting  the  picture  on  the  screen.  This  program  draws  the 
mountains  as  if  the  sun  were  directly  above  them,  for  a  couple 
of  reasons.  Since  the  algorithm  produces  no  overhanging 
pieces,  you  don't  have  to  worry  about  one  part  of  the  land- 
scape shadowing  another  part.  Secondly,  the  program  already 
takes  a  considerable  time  to  work,  without  adding  the  extra 
complication  and  delay  of  computing  the  effect  of  light  falling 
at  an  angle. 

The  landscape  is  stored  as  a  square  grid  of  height  values 
in  an  array  named  Iv.  In  order  to  draw  the  landscape,  each 
surface  in  the  array  must  be  given  a  shade  value  in  relation  to 
how  bright  the  surface  appears.  The  subroutine  Getshade  cal- 
culates the  shade  value  as  the  slope  of  the  plane  in  relation  to 
the  light  source. 

The  problem  is  that  the  four  points  do  not  necessarily  fall 
all  on  the  same  plane.  For  this  reason,  a  point  is  placed  in  the 
center  of  each  square  and  a  separate  shade  value  is  calculated 
for  all  four  triangles  that  are  formed.  What  you  get  is  an  aerial 
view  of  mountains,  islands,  or  whatever  happens  to  come  out. 
The  waterline  is  at  0,  meaning  that  all  points  in  the  viewing 
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area  with  negative  values  are  covered  with  water.  In  addition, 
snow  covers  all  peaks  more  than  three-quarters  as  high  as  the 
highest  point  in  the  picture. 

Fractal  Mountains 

Filename:  FRACTALMTNS 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEVs  Guide  to  Typing  In  Amiga  Programs." 

Copyright  1987  Compute!  Publications,  Inc. 4 
'All  Rights  Reserved. 4 
CLEAR  327674 
DEFSNG  a- z 4 
DIM  Lv<64,64)4 
DIM  cmap$(31)4 
PRINT"     Copyright  1987"4 
PRINVCompute!  Publications,  Inc.  "4 
PRINT"   All  Rights  Reserved. " : PR I NT4 
RAND0MIZE4 

PRINT  "Enter  maximum  variation  (0-2)  (1  is  nice)  " ; : 
INPUT  max 4 

PRINT  "Enter  a  filename  to  save  picture  under. "4 
INPUT  "(Saving  at  end  is  optional.)    ";fiL$4 
FOR  a  =  1  TO  104 
PRINT  RND4 
NEXT4 

SCREEN  2,320,200,5,14 

WINDOW  3, "Mountain", (0,0)  -  (31 1 , 186) , 28, 24 
FOR  a  -  0  TO  154 
PALETTE  a, a/15, a/25, a/504 
PALETTE  a+16, a/15, a/15, a/154 
a*  -  CHR*(a*17)4 

cmap$(a)  =  a*+CHR* (a*10. 2) +CHR* (a*5. 1 ) 4 
cmap*(a+16)  =  a*+a*+a$4 
NEXT4 

PALETTE  16,0,-25,-54 

cmap*(16)  »  CHR*(0)+CHR*(64)+CHR*<128)4 
COLOR  154 
maxLv  =  04 
MakeMount: 4 

FOR  iter  ■  6  TO  1  STEP  -14 
sk  -  2  ~  iter4 
hL  «  sk/24 

PRINT  "Doing  Iteration"; i ter4 
Dot ops: 4 

PRINT  "Tops  &  Bottoms   ";4 
FOR  y  =  0  TO  64  STEP  sk4 
FOR  x  -  hL  TO  64  STEP  sk4 
ran  =  (RND-. 5) *max*sk4 
oLd  =  (Lv(x-hL,y)  +  Lv (x+hL, y) ) /24 
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Lv(x,y)    =   oLd    +    ran4 

NEXT    x4 

NEXT    y4 

Dobottoms:4 

PRINT  "Sides   ";4 

FOR  x  =  0  TO  64  STEP  sk4 

FOR  y  *  hL  TO  64  STEP  sk4 

ran  «  (RND-. 5) *max*sk4 

oLd  =  <Lv<x,y-hL)  +  Lv <x , y+hL) > /24 

Lv(x,y)  *  oLd  +  ran4 

NEXT  y4 

NEXT  x4 

Docentres:4 

PRINT  "Centers   "4 

FOR  x  *  hL  TO  64  STEP  sk4 

FOR  y  =  hL  TO  64  STEP  sk4 

ran  *  (RND-. 5) *max*sk4 

oLdl    -    <Lv(x+hL,y-hL>    +   Lv <x-hL,y+hL> ) /24 

oLd2   -    <Lv(x-hL,y-hL>    +   Lv <x+hL,y+hL> > /24 

oLd  ■  (oLdl  +  oLd2)/24 

Lv(x,y)  «  oLd  +  ran4 

IF  Lv(x,y)  >  maxLv  THEN  maxLv  -  Lv(x,y)4 

NEXT  y4 

NEXT  x4 

NEXT  iter4 

snowLine  ■  maxLv  -  maxLv/44 

drawmount:4 

CLS4 

xm  «  44 

ym  «  14 

xshi-ft  -  .54 

yp  ■  704 

FOR  x  -  0  TO  644 

IF  Lv(x,0)  <  0  THEN  Lv(x,0)  »  04 

NEXT  x4 

FOR  y  -  0  TO  634 

IF  Lv(0,y)  <  0  THEN  Lv(0,y)  ■  04 

FOR  x  -  0  TO  634 

IF  Lv  (x+l,y+l>  <  0  THEN  Lv(x+l,y+l)  ■  04 

Lv  ■  Lv(x,y)  +  Lv(x+l,y)  +Lv(x,y+1)4 

Lv  -  (Lv  +  Lv(x+l,y+l))/44 

a«x:b»y4 

rxl  ■  xm  I  a  +  xshi-ft  *  b4 

ryl  ■  ym  *  b  +  yp  -Lv(a,b)4 

QOSUB  getshade:4 

shadel  =  shade4 

a»x+14 

rx2  ■  xm  t  a  +  xshift  *  b4 

ry2  ■  ym  *  b  +  yp  -Lv(a,b>4 

BOSUB  getshade:4 

shade2  «  shade4 

a-x:b«y+14 
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rx3  ■  xm  <  a  +  xshift  *  b4 

ry3  ■  ym  *  b  +  yp  -Lv(a,b)4 

60SUB  getshade:4 

shade3  =  shaded 

a*x+14 

rx4  *  xm  *  a  +  xshift  *  b4 

ry4  =  ym  |  b  +  yp  -Lv(a,b)4 

BOSUB  getshade:4 

shade4  =  shade4 

a»x+.5:b=y+.54 

rx  ■  x»n  *  a  +  xshift  *  b4 

ry  ■  ym  *  b  +  yp4 

a«=x :  b«y4 

ry   "    ry    -   Lv4 

AREA  <rx,ry)4 

AREA  <rxl,ryl)4 

AREA  <rx2,ry2>4 

COLOR  shadel4 

AREAFILL4 

AREA  (rx,ry)4 

AREA    <rx2,ry2>4 

AREA     <rx4,ry4>4 

COLOR  shade24 

AREAFILL4 

AREA  (rx,ry)4 

AREA  <rxl,ryl>4 

AREA  (rx3,ry3)4 

COLOR  shade34 

AREAFILL4 

AREA  (rx,ry>4 

AREA  <rx3,ry3>4 

AREA  (rx4,ry4)4 

COLOR  shade44 

AREAFILL4 

NEXT  x4 
NEXT  y4 
ender :4 
a*  -  INKEY*4 

IF  a*  =  "s"  THEN  GOTO  savepi c4 
IF  a$  <>  "  "  THEN  GOTO  ender4 
end2:4 

WINDOW  CLOSE  34 
SCREEN  CLOSE  24 
WINDOW  OUTPUT  14 
END4 

get shade: 4 
c  *  x  +  1  -  <b-y>4 
d  *  y  +  <a-x)4 
xc  =  X+.54 
yc  -  y+.54 
xrunl  «  xc  -  a4 
xrun2  =  xc  -  c4 
yrunl  =  yc  -  b4 
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yrun2  =  yc  -  d4 
risel  =  Lv  -  Lv(a,b)4 
rise2  =  Lv  -  Lv(c,d)4 

yrise  =  ABS (riseltxrun2  -  rise2  *xrunl)4 
yrun  =  ABS (yrunl*xrun2  -  xrunltyrun2) 4 
IF  yrun  *  yrise  THEN  yrun  =  1: yrise  ■  14 
xrise  =  ABS(risel*yrun2  -  rise2*yrunl)4 
xrun  ■  ABS (xrun l*yrun2  -  yrunl*xrun2)4 
IF  xrun  =  xrise  THEN  xrun  =  l:xrise  «  14 
xrise  *  xrise  /  24 
yrise  ■  yrise  /  24 

xshade  -  l-ABS(xrise  /  (xrun  +  xrise) )4 
yshade  ■  1 -ABS (yrise  /  (yrun  +  yrise)) 4 
shade  «  14txshadetyshade+l  4 
IF  Lv  >  snowLine  THEN  shade  =  shade  +  164 
IF  Lv  <-  0  THEN  shade  =  164 
RETURN4 
savepic:4 

rastport&  «  WINDOW (8) 4 
bitmap^  -  PEEKL(rastport&+4)4 
topLine  -  60  -  INT(maxLv)4 
IF  topLine  <  0  THEN  topLine  *  04 
topadd  =  topLine  *  404 
FOR  a  -  0  TO  44 

pLane&(a)  «=  PEEKL  (bitmaps  +  8  +  a*4)+topadd4 
NEXT4 

bottomLine  ■  1444 
Lines  -  bottomLine  -  topLine4 
OPEN  fiL*  FOR  OUTPUT  AS  14 
a*  -  MKL* (Lines  *  40  *  5  +  144)4 
PR I NT# 1 , " FORM " ; a* ; " I LBMBMHD " ; MKL* ( 20 ) ; 4 
PRINT#1 , MKI* (320) ; MKI* (Li  nes) ; MKL* (0) ; 4 
PRINT#1 , CHR* (5) ; MKI* (0) ; CHR* (0) ; 4 
PRINTfll , MKI* (0) ; CHR* (10) ; CHR* ( 1 1 ) ; 4 
PRINT#1 , MKI* (320) ; MKI* (200) ; 4 
PRINT#1 , "CMAP" ; MKL* (96) ; 4 
FOR  a  -  0  TO  314 
PRINT#l,cmap*(a);4 
NEXT4 

PRINT#1,"B0DY"; MKL* (Lines  *  40  *  5); 4 
FOR  a  *  1  TO  Lines4 
FOR  p  -  0  TO  44 
FOR  b  -  0  TO  39  STEP  44 
PRINT#l,MKL*(PEEKL(pLaneSc(p)  +  b));4 
NEXT  b4 

POKEL  pLane&(p),-14 
pLane&(p)  =  pLaneSc(p)  +  404 
NEXT  p4 
NEXT  a4 
CL0SE4 
BOTO  end24 
4 
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IFF  Translator 

Michael  Barron 

This  program  translates  IFF  image  files  from  pro- 
grams such  as  Deluxe  Paint  into  files  which  can  be 
used  in  your  own  Amiga  Basic  programs.  It  works 
only  in  conjunction  with  a  drawing  program  that  cre- 
ates IFF-format  image  files  (see  below). 


Amiga  Basic  provides  a  number  of  powerful  OBJECT  com- 
mands for  animating  sprite  and  bob  shapes.  In  order  to  use 
these  commands,  you  must  first  have  an  image  to  animate. 
The  Amiga  Extras  disk  includes  an  object  editor  for  creating 
sprite  and  bob  images;  however,  this  simple  program  has  a 
number  of  limitations.  Commercial  drawing  programs  such  as 
Deluxe  Paint,  Aegis  Images,  and  Graphicraft  are  much  more 
powerful  and  convenient  to  use,  but  the  image  files  which 
they  create  can't  be  used  directly  in  Amiga  Basic. 

"IFF  Translator"  allows  you  to  translate  standard  IFF 
Amiga  graphics  files  for  use  in  BASIC  programs.  (IFF  stands 
for  Interchange  File  Format,  a  standard  file  structure  devel- 
oped jointly  by  Electronic  Arts  and  Commodore- Amiga.  Most 
commercial  drawing  programs  for  the  Amiga  store  images  ac- 
cording to  the  IFF  standards.) 

Creating  an  Image 

Before  you  can  use  IFF  Translator,  you  must  create  an  image 
file  with  Deluxe  Paint  or  any  other  IFF-compatible  program. 
This  article  will  discuss  the  procedure  to  follow  with  Deluxe 
Paint;  other  programs  use  a  similar  process.  Once  you  have 
created  the  image  file,  you  can  run  IFF  Translator  to  convert 
the  file  to  a  form  usable  by  BASIC. 

Before  you  create  the  image,  set  the  drawing  program  to 
the  type  of  screen  which  you'll  need  in  BASIC.  For  instance,  if 
you  wish  the  image  to  be  compatible  with  the  default  (Work- 
bench) screen,  the  drawing  program  should  be  in  medium 
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resolution  with  two  bit  planes.  In  Deluxe  Paint,  the  screen  set- 
ting is  determined  by  the  command  you  use  to  start  the  pro- 
gram from  the  CLI.  Table  6-1  summarizes  the  commands  used 
to  select  different  screens  in  Deluxe  Paint. 

Table  6-1.  Deluxe  Paint  Command  Summary 

1>  DPAINT  <resolution>  <#planes> 

resolution:  #planes: 

LO  320*200  5      5  bit  planes,  32  colors  (low  res  only) 

MED      640*200  4      4  bit  planes,  16  colors 

HI  640*400  3      3  bit  planes,  8  colors 

2      2  bit  planes,  4  colors 

1      1  bit  plane,  2  colors 

The  default  Deluxe  Paint  screen  could  be  entered  as: 
1>  DPAINT  LO  5 

A  Workbench-type  screen  could  be  entered  as: 
1>  DPAINT  MED  2 

IFF  Translator  also  incorporates  the  color  palette  from  the 
original  image  file.  To  change  the  color  palette  in  Deluxe  Paint, 
click  the  left  mouse  button  on  the  foreground  color  indicator 
and  adjust  the  color  sliders  of  the  palette  window  as  needed. 

After  you  have  drawn  the  desired  image,  it  must  be  saved 
as  a  brush.  To  select  an  image  as  a  brush  within  Deluxe  Paint, 
click  the  left  mouse  button  on  the  brush-selection  tool  and 
drag  a  selection  box  around  the  image.  To  save  a  brush  file, 
select  the  Save  As  option  from  the  program's  Brush  menu. 

Exit  the  drawing  program.  At  this  point,  the  image  has 
been  saved  as  a  brush  file  on  disk.  To  minimize  disk-swapping, 
you  may  want  to  copy  the  brush  file  to  your  BASIC  work 
disk.  IFF  Translator  will  store  the  BASIC-compatible  files  in 
the  same  folder  as  the  original  brush  file. 

Using  IFF  Translator 

Type  in  and  save  IFF  Translator;  then  run  it.  The  program  asks 
you  to  enter  the  name  of  an  IFF  file  to  translate.  Enter  the  cor- 
rect name  and  allow  the  program  to  process  the  file.  IFF 
Translator  reads  and  writes  to  disk  until  the  translation  is 
complete,  so  do  not  disturb  the  destination  disk. 

After  the  translation  is  complete,  the  program  recreates 
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the  screen  that  was  in  effect  when  you  created  the  original  im- 
age. Then  it  displays  the  image  on  the  screen  and  permits  you 
to  move  it  around  with  the  mouse  pointer  for  examination. 
Press  any  key  to  exit  the  program. 

IFF  Translator  creates  two  new  files  for  BASIC.  The  first  is 
a  file  of  the  same  name  with  the  extension  _Field.  The  second 
has  the  same  name  with  the  extension  —Image.  For  example,  if 
the  original  file  is  named  FLOWER,  IFF  Translator  creates  files 
named  FLOWER_Field  and  FLOWER_Image. 

The  —Field  file  is  a  BASIC  subroutine  which  recreates  the 
original  screen  from  which  the  image  was  saved.  This  subrou- 
tine, named  DefinePlayField:,  is  stored  in  plain  ASCII  form 
and  can  be  merged  with  an  existing  program  or  used  as  the 
basis  of  a  new  program. 

The  —Image  file  is  compatible  with  OBJECT  commands  in 
Amiga  Basic.  Specifically,  it  is  used  with  OBJECT.SHAPE  to 
define  an  image.  This  image  can  be  used  exactly  like  any  im- 
age created  with  the  BASIC  object  editor  program.  The  follow- 
ing code  demonstrates  how  to  read  and  define  an  image 
contained  in  an  —Image  file: 

OPEN  "filename-\m<L&"  FOR  INPUT  AS  1 
OBJECT.SHAPE  l,INPUTS$(LOF(l),l) 
CLOSE  1 

Of  course,  you  should  replace  filename  in  the  OPEN  com- 
mand with  the  name  used  for  your  file.  Once  the  object  has 
been  defined,  it  can  be  manipulated  like  any  other  object,  as 
explained  in  the  Amiga  Basic  manual. 

IFF  Translator 

Filename:  IFFTRANS 

For  instructions  on  entering  this  program,  please  re/er  to  Appendix  B, 
"COMPUTEVs  Guide  to  Typing  In  Amiga  Programs." 

4 

4 

' TranslatelFF  4 

'Use  IFF  brash  files  with  AmigaBASIC  object  commands 

4 

'Copyright  1987  Compute!  Publications,  Inc4 

'All  Rights  Reserved^ 

4 

4 
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Mainl ine: 4 

GOSUB  Initialize* 

OPEN  FilelFF*  FOR  INPUT  AS  14 

PRINT  "Reading  from  file     :  ";FileIFF*4 
GOSUB  Transl ateChunks4 
CLOSE  14 
OPEN  FileIFF*+"_Field"  FOR  OUTPUT  AS  14 

PRINT  "Writing  to  file       :  " ;Fi leIFF*+"_Field 
"4 

GOSUB  CreateFieldFile4 
CLOSE  14 
OPEN  FileIFF*+"_Image"  FOR  OUTPUT  AS  14 

PRINT  "Writing  to  file       s  "; Fi leIFF*+"_Image 
"4 

GOSUB  Create I mageFi le4 
CLOSE  14 

GOSUB  DisplayB0B4 
END4 
4 
Initialize:* 

WINDOW  l,"TranslateIFF", (0, 136)-(450, 186), 154 
DEFINT  a-z4 

DIM  R! (31), G! (31), B! (31)4 
True*- 14 
False=04 

INPUT  "IFF  file  to  translate:  ",FileIFF*4 
RETURN4 
4 

Transl ateChunks: 4 
ckID*=INPUT*(4, 1)4 
SkipData*=INPUT*(4, 1)4 
ckTypeS-INPUT* (4,1)4 

IF  ckID*O"F0RM"  OR  ckType*<>" ILBM"  THEN4 
PRINT  "File  is  not  a  FORM  ILBM  chunk. "4 
ST0P4 
END  IF4 

FoundBMHD«Fal se4 
FoundCMAP«False4 
WHILE  True4 

ckID*»INPUT*(4,l)4 
ckLength&»CVL ( INPUT* (4, 1 ) ) 4 
IF  cklDS^BMHD"  THEN4 
GOSUB  Transl ateBMHD4 
FoundBMHD=True4 
ELSE IF  ckID*="CMAP"  THEN4 
GOSUB  Transl ateCMAP4 
FoundCMAP-True4 
ELSE IF  ckID*«"BQDY"  THEN4 

IF  FoundBMHD  AND  FoundCMAP  THEN4 
GOSUB  Transl ateB0DY4 
RETURN4 
ELSE4 
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PRINT  "Context  chunks  are  missing."* 
STOP* 
END  IF4 

ELSE4 

SkipData*-INPUT*(ckLength8<,  1)4 
SkipData*=""4 

END    IF4 

IF  ckLengthSc  MOD  2  THEN4 
Sk  i  pDat a*« I NPUT* (1,1)4 

END  IF4 
WEND4 
4 
TranslateBMHDi4 

Wi de&-CVI  ( INPUT*  (2,  1  >  )  4 

Hei  ght8c-CVI  ( INPUTS  (2,  1 )  )  4 

Ski  pData*«INPUT* (4, 1 ) 4 

Depth*c-ASC  (INPUTS  ( 1 ,  1 )  )  4 

Maski  ng«ASC ( INPUTS ( 1 , 1 ) ) 4 

Compress! on-ASC ( INPUT* ( 1 , 1 ) ) 4 

Ski  pData*- INPUT* (1,1)4 

Tr ansCol or-CV I ( I NPUT* ( 2 , 1 ) ) 4 

Ski  pData*«INPUT* (2,1)4 

PageWi  dth-CVI ( INPUT* (2, 1 ) ) 4 

PageHei  ght«CVI ( INPUT* (2, 1 ) >  4 

ScnMode-PageWi  dth/320+2» (PageHei  ght /200-1 ) 4 

PlanePick»2^Depth8<-14 

IF  Maski ng<>2  THEN4 

PRINT  "Unknown  masking  technique  used. "4 

ST0P4 
END  IF4 
IF  Compression-0  THEN4 

Fi 1 eCompressed^Fal se4 
ELSE IF  Compression«l  THEN4 

Fi 1 eCompressed«True4 
ELSE4 

PRINT  "Unknown  compression  technique  used. "4 

ST0P4 
END  IF4 
IF  TransColor<>0  THEN4 

PRINT  "Register  zero  is  not  the  transparent  colo 
r."4 

ST0P4 
END  IF4 

Header *=MKL* (0) +MKL* (0) +MKL* (Depths ) +MKL* (Widefc) +M 
KL*(Height&)4 

Header *=Header*+MK I* (24) +MKI* (PI anePick) +MKI* (0) 4 
RETURN4 
4 
TranslateCMAP:4 

ColorCount=ckLength&/3-14 
FOR  Register «=0  TO  ColorCount4 
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R !  (Regi  ster ) ~INT (ASC ( INPUT*  < 1 , 1 ) > /12> /204 
G !  (Regi  ster ) *INT (ASC ( INPUT* ( 1 , 1 ) ) / 12) /204 
B! <Register)=INT(ASC<INPUT*(l, 1) )/12)/204 
NEXT  Register4 
RETURN4 
4 
TranslateB0DY:4 

BytesPerRow=2*INT((Wide8<+15)/16)4 
BytesPerPl ane»BytesPer RowtHei ght&4 
ReqBytes=BytesPerPl ane*Depth&4 
Bi  tMap*=STRING* (ReqBytes, CHR*  <0) ) 4 
FOR  RowNo=l  TO  Heigh t&4 

Pointer=l+BytesPerRow*(RowNo-l)4 
FOR  PlaneNo=l  TO  Depth«c4 

Of  f  set=By t esPer  PI ane* ( PI aneNo- 1 ) 4 
IF  FileCompressed  THEN4 
Raw*=,,H4 

WHILE  LEN(Row*XBytesPerRow4 
UByte=ASC ( INPUT*  ( 1 ,  1 )  )  4 
Control Byte=UByte-2*(UByte  AND  128)4 
IF  ContralByte<-127  THEN4 

'No  0peration4 
ELSEIF  Control Byte<0  THEN4 

Row*=Row*+STRING* (-Control By te+1 , INPUT*  < 
1,  1) )4 

ELSEIF  Control  By te< 128  THEN4 

Row**Row*+ 1 NPUT*  <  Control  By t e+ 1,1)4 
END  IF4 
WEND4 
ELSE4 

Row*«INPUT* (BytesPerRow, 1 ) 4 
END  IF4 

MID* (BitMap*, Poi nter+Of f set, BytesPerRow) =Row*4 
NEXT  PlaneNo4 
NEXT  RowNo4 
RETURN4 
4 
CreateFieldFile:4 

PRINT#1, "DefinePlayField: "4 

PRINT#1, USING  "   SCREEN  1 _,###_,###_,#_, #";PageWid 
th , PageHei  ght , Depth&, ScnMode4 

PRINT#1,  "   WINDOW  l,";CHR*(34);FileIFF*;CHR*<34); 
",,3,1"4 

FOR  Regi ster =0  TO  Col or Count 4 

PRINT  #1, USING  "   PALETTE  ##_,#.##_,#.##_,#.##"; 
Register, R! (Register) ,G! (Register) ,B ! (Register)4 
NEXT  Register4 
PRINT  #1,"   RETURN "4 
RETURN4 
4 
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CreatelmageFi 1 e: 4 

PRINT  #  1,  Header  *-H3it  Map*;  4 

RETURN4 

4 
Display BOB: 4 

SCREEN  1 , PageWi dth , PageHei  ght , Dept h& , ScnMode4 

WINDOW  2,"DisplayBOB",,0,14 

FOR  Register»0  TO  ColorCount4 

PALETTE  Register, R! (Register) ,G! (Register) ,B! (Re 
gister)4 

NEXT  Register4 

PRINT  "Hit  any  key  to  return  to  BASIC. "4 

PRINT  "Manipulate  BOB  with  mouse  pointer. "4 

OBJECT. SHAPE  1 , Header *+BitMap*4 

OBJECT. X  1,04 

OBJECT. Y  1,164 

OBJECT. 0N4 

WHILE  INKEY*«!,,,4 

IF  MOUSE (0)<>0  THEN4 

OBJECT. X  1,M0USE(1)-Wide&4 
OBJECT.  Y  1,  MOUSE  < 2)  -Heights 
END  IF4 

WEND4 

OBJECT. 0FF4 

WINDOW  14 

SCREEN  CLOSE  14 

RETURN4 

4 
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IFF  to  Icon 
Translator 

Charles  L.  Baker 


Design  your  own  Workbench  icons  using  programs 

such  as  Deluxe  Paint,  Aegis  Images,  and  Graphicraft. 

Requires  Workbench  1.2. 

"IFF  to  Icon"  lets  you  customize  your  Workbench  icons  by 
translating  IFF  image  files  into  Workbench  .info  files.  IFF  (In- 
terchange File  Format)  is  a  standard  file  structure  developed 
jointly  by  Electronic  Arts  and  Commodore-Amiga.  Most  com- 
mercial drawing  programs  for  the  Amiga  store  images  accord- 
ing to  the  IFF  standards. 

In  order  for  a  file's  icon  to  appear  on  the  Workbench 
screen,  there  must  be  a  corresponding  .info  file.  The  Prefer- 
ences program,  for  example,  has  the  Preferences. info  file  asso- 
ciated with  it.  Drawers,  the  Trashcan  (a  special  type  of 
drawer),  and  even  disks  use  .info  files  to  describe  what  their 
icons  look  like.  By  modifying  .info  files,  we  can  redefine 
Workbench  icons. 

Creating  an  Image 

Before  you  can  use  this  program,  you  must  create  an  image 
file  with  Deluxe  Paint  or  any  other  IFF-compatible  program. 
This  article  will  describe  what  you  must  do  when  using  Deluxe 
Paint;  other  programs  use  a  similar  process.  Once  you  have 
created  the  image  file,  you  can  run  IFF  to  Icon  to  convert  your 
image  into  a  Workbench  icon. 

Before  you  create  the  image,  set  the  drawing  program  to 
the  type  of  screen  which  your  Workbench  uses — either  medium- 
resolution  or  high-resolution  (interlace).  The  icon's  colors  are 
ultimately  determined  by  the  Workbench  and  not  the  drawing 
program  used  to  design  the  icon.  You  may  use  the  Preferences 
program  to  change  the  Workbench  colors.  Remember  that  the 
Workbench  only  uses  four  colors.  After  you  have  drawn  the 
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desired  image,  it  must  be  saved  as  a  brush.  To  select  an  image 
as  a  brush  within  Deluxe  Paint,  click  the  left  mouse  button  on 
the  brush-selection  tool  and  drag  a  selection  box  around  the 
image.  To  save  a  brush  file,  select  Save  or  Save  As  from  the 
Brush  menu. 

Exit  the  drawing  program.  At  this  point,  the  image  has 
been  saved  as  a  brush  file  on  disk.  To  minimize  disk  swap- 
ping, you  should  copy  the  brush  file  to  your  BASIC  work  disk. 

Getting  Started 

Type  in  and  save  IFF  to  Icon.  The  program  uses  the  system  li- 
brary file  named  icon.bmap.  In  order  for  Amiga  Basic  to  use 
this  library,  it  must  have  a  file  description  of  the  library  in  a 
form  which  it  understands.  This  form  is  called  a  .bmap  file. 
The  .bmap  file  is  essentially  a  list  of  pointers  that  allow  Amiga 
Basic  to  access  library  routines. 

The  file  icon.bmap  must  be  created  before  you  can  run 
IFF  to  Icon.  If  you  have  version  1.2  of  the  Amiga  operating 
system  (available  as  an  inexpensive  upgrade  from  any  Amiga 
dealer),  you  can  create  icon.bmap  quite  easily.  The  BASICDemos 
disk  for  1.2  contains  a  BASIC  program  named  ConvertFD,  as 
well  as  a  directory  named  FD1.2.  Run  the  ConvertFD  program 
and  enter  the  following  information  when  prompted: 

Enter  name  of  id  file  to  read  > 

Extras:fdl.2/icon_lib.fd 
Enter  name  of  .bmap  file  to  produce  > 

Libs:icon.bmap 

When  the  ConvertFD  program  is  finished,  the  disk  con- 
tains the  icon.bmap  file.  Copy  this  file  onto  the  same  disk  as 
the  IFF  to  Icon  program.  When  IFF  to  Icon  is  run,  the 
icon.bmap  file  must  be  either  in  the  current  directory  or  in  the 
directory  named  LIBS  (LIBrarieS)  on  the  disk  used  when  you 
booted  the  system.  The  LIBS  directory  is  a  good  place  for 
.bmap  files,  since  their  purpose  is  to  give  you  access  to  librar- 
ies. If  you  don't  have  the  .bmap  files  in  the  correct  place, 
BASIC  will  stop  with  a  file  not  found  error  when  you  run  IFF 
to  Icon. 
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Using  the  Program 

Run  IFF  to  Icon.  The  program  asks  you  to  enter  the  name  of 
the  IFF  file  to  translate  and  the  name  of  the  .info  file  to  mod- 
ify. You  must  specify  the  disk  and  folder  in  which  the  pro- 
grams are  located.  Do  not  include  the  .info  extension  when 
entering  the  second  filename.  The  program  does  this  for  you. 
If  you  wish  to  change  the  trashcan's  icon,  for  example,  simply 
enter  the  filename  TRASHCAN.  The  IFF  to  Icon  program  does 
not  create  new  .info  files;  it  modifies  existing  ones.  So,  the 
.info  file  must  already  exist  on  disk.  After  both  filenames  have 
been  entered,  IFF  to  Icon  translates  the  IFF  image,  creates  a 
temporary  image  file  of  its  own,  and  finally  modifies  the  spec- 
ified .info  file.  To  convert  IFF  image  files,  this  program  uses 
code  from  the  IFF  Translator  program. 

Even  after  modification,  a  file's  original  icon  will  stay  on 
the  Workbench  screen  until  the  file,  drawer,  or  disk  is  closed 
and  redrawn.  For  files  and  drawers,  this  means  closing  and  re- 
opening the  window  that  the  icon  is  located  in.  If  you  modi- 
fied a  disk's  icon,  you  must  close  all  drawers  and  windows 
from  the  disk,  remove  the  disk  from  the  drive,  and  reinsert  the 
disk  after  the  original  icon  has  disappeared.  In  some  cases, 
you  may  have  to  reboot  in  order  to  remove  the  original  disk 
icon  from  the  Workbench  screen. 

IFF  to  Icon  Translator 

Filename:  IFFICON 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

*   Copyright  1987  COMPUTE!  Publications,  Inc. 4 

'   All  Rights  Reserved* 

'* 

IFF  to  Icon* 

'* 

DECLARE  FUNCTION  GetDiskOb ject&  LIBRARY* 

DECLARE  FUNCTION  PutDiskOb ject&  LIBRARY* 

DECLARE  FUNCTION  FreeDiskOb ject&  LIBRARY* 

* 

LIBRARY  "icon. library"* 

* 

MainLine:* 
60SUB  InitiaLize* 
OPEN  FiLelFFS  FOR  INPUT  AS  1* 
PRINT  "Reading  from  file     :  ";FiLeIFF«* 
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BOSUB  TransLateChunks4 
CLOSE  14 

OPEN  FiLeIFF*+"_Image"  FOR  OUTPUT  AS  14 
PRINT  "Writing  to  file       :  ";FiLeIFFS+"_Image"4 
GOSUB  Create I mageFiLe4 
CLOSE  14 

OPEN  FiLeIFF*+"_Image"  FOR  INPUT  AS  14 
PRINT  "Translating  file      :  ";FiLeIFF*+"_Image"4 
GOSUB  TransLateImage4 
CLOSE  14 

KILL  FiLeIFF*+"_Image"4 

PRINT  "Modifying  file        :  ";FiLeInf o*+". inf o"4 
GOSUB  CreateInfoFiLe4 
LIBRARY  CL0SE4 
END4 
4 

InitiaLize:4 
WINDOW  1, "Brush  To  Icon", (0, 120) - (450, 186) , 154 
PRINT  "Copyright  1987  COMPUTE!  Publications,  Inc. u< 
PRINT  "  All  Rights  Reserved. ": PR I NT4 

DEFINT  a-z4 

DIM  RK31),  61(31),  BK3D4 
true  «  -14 
faLse  ■  04 

INPUT  "IFF  file  to  translate:  ",FiLeIFF*4 
INPUT  ".info  file  to  modify  :  ",FiLeInfo*4 
RETURN4 
4 

Tr an sLat ©Chunks: 4 
ck IDS-INPUT* <4, 1)4 
SkipData*«INPUT*<4, 1)4 
ckType*« INPUT* (4, 1 ) 4 

IF  ckID*  <>  "FORM"  OR  ckType*  <>  "ILBM"  THEN4 
PRINT  "File  is  not  a  FORM  ILBM  chunk. "4 
ST0P4 
END  IF4 

FoundBMHD  *  faLse4 
FoundCMAP  -  faLse4 
WHILE  true4 
ckID*«INPUT*(4,l)4 
ckLength«c«CVL  ( INPUT*  (4,  1 )  )  4 
IF  ckID*-"BMHD"  THEN4 
GOSUB  TransLateBMHD4 
FoundBMHD  «  true4 
ELSE IF  ckID*»"CMAP"  THEN4 
GOSUB  TranslateCMAP4 
FoundCMAP  -  true4 
ELSE IF  ckID*«"BODY"  THEN4 
IF  FoundBMHD  AND  FoundCMAP  THEN4 
GOSUB  TransLateB0DY4 
RETURN4 
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ELSE* 

PRINT  "Context  chunks  are  missing. "4 
ST0P4 
END  IF4 
ELSE4 
SkipDataS«INPUTS(ckLength&, 1)4 
SkipDataS=""4 
END  IF4 
IF  ckLengthfc  MOD  2  THEN4 

Ski  pDataS=INPUTS (1,1)4 
END  IF4 
WEND4 
4 

TransLateBMHD:4 
Mi de&«CVI  ( INPUTS  (2,  1 )  )  4 
Hei  gh t&«CV  I  ( I NPUTS  ( 2 ,  1 )  )  4 
Sk  i  pDat aS-=  I NPUTS  (4,1)4 
depth&«ASC ( INPUTS ( 1 ,  1 )  )  4 
Maski  ng-ASC ( INPUT* ( 1 ,  1 )  )  4 
Compressi  on-ASC ( INPUTS ( 1 ,  1 )  )  4 
Ski  pDataS= INPUTS (1,1)4 
TransCoLor=CVI ( INPUTS (2, 1 ) ) 4 
Ski  pDataS" INPUTS (2, 1 ) 4 
PageWi  dth«CVI ( INPUTS (2, 1 ) ) 4 
PageHeight-CVI (INPUTS (2, 1) )4 
ScnMode«PageWidth/320+2*(PageHeight/200-l)4 
pLanepick«2^depth&-14 
IF  Maski ng<>2  THEN4 

PRINT  "Unknown  masking  technique  used. "4 
ST0P4 
END  IF4 

IF  Compression  *  0  THEN4 
FiLeCom pressed  »  -FaLse4 
ELSEIF  Compression  *  1  THEN4 

FiLeCompressed  =  true4 
ELSE4 

PRINT  "Unknown  compression  technique  used. "4 
ST0P4 
END  IF4 
IF  TransCoLor  <>0  THEN4 

PRINT  "Register  zero  is  not  the  transparent  color 
."4 

ST0P4 
END  IF4 

Header *«MKLS  (0)  +MKLS  (0)  +MKLS  (depth*)  +MKL.S  (Wide*) +MK 
L*(Height&)4 

HeaderS=HeaderS+MKlS(24)+MKIS(pLanepick)+MKlS(0)4 
RETURN4 
4 
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TranslateCMAP:4 
CoLorCount=ckLength&/3-14 
FOR  register=0  TO  CoLorCount4 
Rl (regi  ster ) =INT ( ASC (INPUT*  < 1 , 1 ) ) / 12) /204 
Gl (register )=INT(ASC( INPUT* (1, 1) )/12)/204 
Bl (register)«INT(ASC(INPUT*(l, 1) )/12)/204 
NEXT  register4 
RETURN4 
4 
TransLateB0DY:4 

BytesPerRow  -  2*INT  (  (Wide&+15)  /16)  4 
BytesPerPLane  =  BytesPerRow*Height&4 
ReqBytes  ■  BytesPerPLane*depth&4 
Bi  tMap*=STRINB* (ReqBytes, CHR* (0) ) 4 
FOR  RowNo=l  TO  Height &4 
pointer«l+BytesPerRow* (RowNo-l)4 
FOR  PLaneNo=l  TO  depth&4 
Of f set=BytesPerPLane* (PLaneNo-1 ) 4 
IF  FiLeCompressed  THEN4 
Row*- ""4 

WHILE  LEN(Row*XBytesPerRow4 
UByte«ASC ( INPUT* ( 1 ,  1 )  )  4 
ControLByte«UByte-2*(UByte  AND  128)4 
IF  ControLByte<-127  THEN4 
'  No  operation4 
ELSE IF  ControLByte<0  THEN4 

Row*«Row*+STRIN8* (-ControLByte+1 , INPUT* ( 1 , 1 ) ) 4 
ELSEIF  ControLByte<128  THEN4 
Row*«Row*+ INPUT* (ControLByte+1 ,1)4 
END  IF4 
WEND4 
ELSE4 

Row*- INPUT* (BytesPerRow, 1 ) 4 
END  IF4 

MID* (BitMap*, poi nter+Off set, BytesPerRow) «Row*4 
NEXT  PLaneNo4 
NEXT  RowNo4 
RETURN4 
4 
Create I mageFi Le: 4 

PRINT#lf  Header*+BitMap*;4 
RETURN4 
4 
TransLatelmage: 4 

garbage*     -  INPUT* (8,1) 
et  and  dataset4 


throw  away  colors 


depth** 
n  bitmaps4 

bwidth* 
n  pixels4 

bheight& 


■  CVL(INPUT*(4,1)) 

■  CVL(INPUT*(4f 1)) 
=  CVL(INPUT*(4,1)) 


depth  of  screen  i 


width  of  screen  i 


height  of  screen 
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■    INPUT* (2, 1) 

-  CVI (INPUT* <2,1))4 

-  CVI(INPUT*<2,1>)4 

-  INPUT*(LQF<l>-26, 1) 


drop  masking  flag 


bitplane  data* 


in  pixels* 

garbage* 
s4 

pLanepickX 

pLaneonof  f  V. 

bit* 
RETURN4 
4 
Createlnf oFi  Le:  4 

diskobjfe  ■  GetDisk0bject&<SADD<FiLeInfo*>>4 

IF  diskobjfc  -  0  THEN4 
PRINT  "error  opening  ";FiLeInf o*; ". inf o"4 
SOTO  ending* 

END  IF4 

POKEL  diskobjSc 

POKEW  diskobj& 

POKEW  diskobjSc 


8,  0     '  top  corner  at  0,04 
12,  bwidth&4 
+  14,  bheight&4 
imageptrfc  -  PEEKL<diskob j«<  +  22)4 
POKEW  imageptr*  +  4,   bwidth&4 
+  6,   bheight&4 
+  8,   depth&4 
+  10,  SADD(bit*)4 
+  14,  pLanepickX4 
+  15,  pLaneonof f%4 
erro&»PutDiskObject&<SADD<FiLeInfo*>  ,  diskobj&>4 
IF  errofc  *  0  THEN4 

PRINT  "error  on  file  writing  "4 
END  IF4 

erro&«FreeDisk0bject&(diskobj&)4 
IF  erro&  <>  0  THEN4 


POKEW  imageptrfe 
POKEW  imageptr& 
POKEL  imageptrSc 
POKE  imageptrSc 
POKE   imageptrSc 


PRINT 
END  IF4 
ending: 4 
RETURN4 

4 


"error  on  memory  clearing  — >  "; err o&4 


192 


Math  Draw 

Rhett  Anderson 


Create  complex  geometric  patterns  with  this  menu- 
driven  graphics  program  for  the  Amiga.  When 
you've  finished,  you  can  save  your  picture  as  an  IFF 
graphics  file  for  use  with  Deluxe  Paint  II  and  other 
Amiga  paint  programs.  Requires  512K. 


"Math  Draw"  shows  you  how  to  create  intricate  geometric  de- 
signs and  patterns,  even  if  you  don't  understand  the  math- 
ematics behind  them.  Use  the  special  menu  to  select  from  a 
palette  of  32  different  colors  and  several  different  drawing  op- 
tions. When  you've  finished  your  picture,  you  can  save  it  in 
IFF  ILBM  format,  which  is  used  by  most  paint  programs. 

Math  Draw  is  written  in  Amiga  Basic.  Type  it  in  and  save 
it  to  disk.  When  you're  ready  to  use  the  program,  load  and 
run  it. 

Math  Draw  starts  drawing  immediately.  After  you've  seen 
the  pattern  it  draws,  activate  the  Amiga  menus  by  pressing  the 
right  mouse  button.  Math  Draw  adds  an  Option  menu  to 
Amiga  Basic's  menus.  While  holding  the  right  button,  slide  the 
mouse  pointer  up  to  the  word  Option  to  see  the  new  menu 
options.  To  choose  an  option,  release  the  button  while  point- 
ing to  the  desired  option.  Here  is  a  list  of  the  new  options: 

•  Color  Control.  When  you  activate  this  function,  you'll  be 
presented  with  a  chart  which  shows  32  colors,  each  labeled 
with  a  number.  Choose  a  new  drawing  color  by  entering  a 
number.  The  32  colors  are  fixed;  they  cannot  be  changed 
from  within  the  program.  If  you  wish  to  change  the  colors, 
you'll  need  to  modify  the  numbers  in  the  first  set  of  DATA 
statements  in  the  program. 

•  Radius  Control.  Math  Draw  works  by  moving  an  imaginary 
circle  inside  or  outside  another  imaginary  circle.  The  drawing 
pen  is  "attached"  to  the  edge  of  the  moving  circle.  You 
change  the  size  of  these  circles  (and  thus  the  scale  of  your 
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drawing)  by  choosing  the  Radius  Control  menu  selection. 
You'll  be  asked  for  new  radius  values  for  the  circles. 

•  Growth  Control.  If  you  choose,  the  imaginary  circles  used  to 
move  the  drawing  pen  can  grow  at  a  fixed  rate.  This  feature 
can  be  used  to  create  spirals  and  shell  designs.  Normally, 
you'll  want  to  keep  this  parameter  at  its  default  value,  0.  A 
reasonable  growth  rate  is  0.01.  A  negative  number  will  make 
the  circles  shrink. 

•  Type  Control.  This  option  lets  you  choose  between  drawing 
epicycloids  and  hypocycloids.  In  an  epicycloid,  the  moving 
circle  moves  around  the  outside  of  the  stationary  circle.  In  a 
hypocycloid,  the  moving  circle  moves  around  the  inside  of 
the  stationary  one. 

•  Pause.  This  option  halts  drawing.  After  selecting  this  option, 
the  drawing  pen  freezes.  This  is  useful  when  you  want  to 
make  several  changes  to  the  pen  at  once.  For  instance,  you 
may  want  to  change  the  pen  color  and  the  outer  radius  at  the 
same  time.  Select  Pause  and  then  use  the  menu  options  to 
select  the  new  color  and  the  new  radii. 

•  Continue.  Ends  Pause  mode  and  starts  the  pen  moving 
again. 

•  Save  Picture.  Saves  your  picture  as  an  IFF  file  compatible 
with  Deluxe  Paint  II,  Digi-Paint,  Aegis  Images,  and  other 
Amiga  paint  programs.  Since  the  save  routine  is  written  en- 
tirely in  BASIC,  it  takes  a  few  minutes  to  save  a  picture.  Be 
sure  not  to  drop  any  menus  down  while  the  picture  is  being 
saved,  or  else  youTl  see  ghosts  of  the  menus  in  your  saved 
pictures. 

•  Clear.  Clears  the  screen.  Since  your  work  could  be  lost  if  you 
accidentally  select  this  option,  youTl  be  asked  whether  you're 
sure  you  want  to  clear  the  screen. 

•  Quit.  Exits  to  BASIC  cleanly.  You  should  always  use  this 
menu  option  to  stop  the  program.  If  you  quit  another  way, 
type  MENU  RESET  to  disable  the  Math  Draw  menu  and 
SCREEN  CLOSE  1  to  free  up  the  screen  created  by  Math 
Draw.  Since  your  work  could  be  lost  if  you  select  this  option 
accidentally,  youTl  be  asked  whether  you're  sure  you  want  to 
quit. 
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Your  First  Drawing 

Let's  create  a  picture.  First,  select  Pause  to  freeze  the  drawing 
pen.  Now  select  Clear  to  erase  any  picture  that  might  be  on 
the  screen.  Select  Color  Control  and  pick  a  color.  Now  select 
Radius  Control.  Type  30  at  the  first  prompt  and  8  at  the  sec- 
ond. Select  Continue,  and  a  pattern  will  be  drawn.  When  the 
pattern  begins  to  repeat,  select  Pause  again  and  then  change 
the  color.  Change  the  radii  to  50  and  10.  Repeat  this  process 
until  you're  satisfied  with  your  picture.  If  you  wish  to  save  it, 
select  the  Save  option. 

When  you're  ready  for  a  new  effect,  turn  on  the  Growth 
control.  A  moderate  value  for  Growth  is  0.01,  but  try  values 
like  0.001,  1,  and  10  to  see  how  Growth  works. 

Table  6-2  has  six  sets  of  parameters  that  produce  attractive 
designs.  After  seeing  what  they  do,  try  combining  them. 

Table  6-2.  Example  Designs 


Radius  1 

Radius  2 

Growth 

Type 

120 

35 

0 

2 

75 

25 

-.1 

1 

10 

45 

0 

2 

80 

46 

0 

2 

30 

16 

0 

1 

40 

16 

0 

1 

After  you  have  saved  a  couple  of  pictures,  go  to  a  paint 
program  and  fill  in  different  areas  with  different  colors.  From 
within  the  paint  program,  you  can  modify  the  palette  colors  if 
you  like. 

Math  Draw 

Filename:  MATHDRAW 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

"Math    Draw* 

? Copyright  1988* 

'COMPUTE!  Publications,  Inc.* 

:' All  Rights  Reserved* 

CLEAR  32767* 

DEFSNG  a-z  s  DEFDBL  g.h^theta* 

TRUE'/.  =  -1  :  FALSE"/-  =0  5  PI  =  3.141593  :  speed  «  PI/ 

100* 
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DIM   cmap*(31>* 

col  ours:  * 
DATA  0,0,0,  10,10,10,  6,0,0,  9,0,0,  12,0,0,  15,0,0* 
DATA  0,6,0,  0,9,0,  0,12,0,  0,15,0,  0,0,6,  0,0,9* 
DATA  0,0,12,  0,0,15,  4,4,0,  7,7,0,  10,10,0,  13,13,0 

DATA  4,0,4,  7,0,7,  10,0,10,  13,0,13,  6,3,0,  8,4,0* 
DATA  10,5,0,  12,6,0,  4,8,12,  8,4,12,  4,12,8,  12,8,4 

DATA  12,4,8,  8,12,4* 

ON  BREAK  GOSUB  NoMore* 
BREAK  ON-- 
SCREEN 1,320,200,5,1: WINDOW  3, " " , (0, 0) - (31 1 , 186) , 16, 
1: WINDOW  OUTPUT  3* 
RESTORE  colours* 
FOR  i"/.=0  TO  31* 

READ  r,g,b* 

PALETTE  i"/.,r/15,g/15,b/15* 

cmap*(i7.)=CHR*(r*17)-«-CHR*(g*17)+CHR*(b*17)* 
NEXT  i"/.   * 

MENU  3,0, 1, "Options"* 
MENU  3, 1,1, "Color  Control"* 
MENU  3,2, 1, "Radius  Control"* 
MENU  3,3, 1, "Growth  Control"* 
MENU  3,4,1, "Type  Control"* 
MENU  3,5,1, "Save  Picture"* 
MENU  3,6, 1, "Pause"* 
MENU  3,7, 1, "Continue"* 
MENU  3,8, 1, "Clear"* 
MENU  3,9, 1, "Quit"* 
ON  MENU  GOSUB  checkmenu* 

a=  1 00 :b=20:type"/.=  l:  colour= 10:  del  taA=0:  del  taB=0* 
starting  =  TRUE"/.  :  pause  =  FALSE"/.* 
nextpoint: * 
MENU  ON* 

WHILE  pause: WEND* 
MENU  STOP* 

g  =  <a+b)/b  :  h  =  <a-b)/b* 

theta  =  theta+speed* 

a  =  a+deltaA* 

b  =  b+deltaB* 

oldx  =  x:  oldy  =  y* 

IF  type"/.  =  1  THEN  GOSUB  Epicycloid  ELSE  GOSUB  Hypoc 
ycl oid* 

IF  NOT  starting  THEN  LINE  ( 160+oldx , 100+oldy*. 88) - ( 
160+x, 100+y*.88> , col  our* 

starting  =  FALSE"/.* 
GOTO  nextpoint* 
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Epicycloid: 4 

x  =  (a+b) *C0S(theta)~b*C0S(g*theta)4 

y  =  (a+b) *SIN(theta)-b#SIN(g*theta)4 
RETURNS 
*~ 

Hypocycl  oi  d:  4 

x=  (a--b)  *COS  (theta)  +b*COS  (h*theta)  4 

y=(a~b)*SIN(theta)-b*SIN(h*theta)4 
RETURN  4 

checkmenu:  4 
menuid=MENU<0)4 
ffienui  tem-MENU  (1)4 
IF  menuid=3  THEN* 
IF  menu  item  =  1  THEN4 
WINDOW  4,"", (0,0)- (260,82), 18,1: WINDOW  OUTPUT  44 
FOR  xx7.=0  TO  74 
FOR  yy7.=0  TO  34 
LINE  (xx7.#32+ 16?yy7.*l 6+8) -(x*7.*32+245yy7.*  16+16) 
„x>;7.+yy7.*8,b-f  4 

LOCATE  yy7.*2+2.,xx7.*4+14 
PRINT  RIGHT*  (STR*(xx7.+yy7.#8)  ,2)  ;  4 
NEXT  yy7.4 
NEXT  x>: 74 
LOCATE  10,44 
INPUT  "Choose  a  Col  or "; col  our  :  colour=col our  MOD 

WINDOW  OUTPUT  34 

WINDOW  CLOSE  44 
END  IF4 
IF  menuitem  =  2  THEN4 

WINDOW  4,  "",  (0,0) -(280, 65) , 18, 1: WINDOW  OUTPUT  44 

PRINT  "Current  Radius" : PRINT"  of  Stationary  Circl 
e: " ; a4 

INPUT  "New  Radius" 5 a4 

PRINT  "Current  Radi us" : PRINT"  of  Moving  Circle:"; 
b4 

INPUT  "New  Radius";b4 

a=ABS(a) :b=ABS(b)4 

IF  a=0  THEN  a=14 

IF  b=0  THEN  b=14 

starting  =  TF<UE7.4 

WINDOW  OUTPUT  34 

WINDOW  CLOSE  44 
END  IF4 
IF  menuitem  =  3  THEN4 

WINDOW  4, "",  (0,0)-(300550), 18, Is  WINDOW  OUTPUT  44 

PRINT  "Current  Growth  Rate: "; del taA4 

INPUT  "New  Rate";deltaA: IF  a<>0  THEN  del taB=delta 
A*b/a4 
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starting  =  TRUE"/.* 
WINDOW  OUTPUT  3* 
WINDOW  CLOSE  4* 
END  IF* 

I F  m e n u i  t  e m  =  4  THEN * 
WINDOW  4,  "",  (0,0>--X250,50)  ,48^  UWXNDQW  OUTPUT  4* 
PRINT  "Choose  a  Type:  "* 
PRINT  "1.  Epicycloid  (Outside)"* 
PR I  NT  " 2 .  Hyp dc y c 1 o i  d  (Inside)"* 
PR  I  NT  s  PR  I  NT  "  Cur  r  en  t  Type  =  "  ;  type"/.* 
INPUT  "New  Type"  ;  type"/.* 

IF  type"/-  =  2  THEN  speed  =  PI/50  ELSE  speed  =  PI/1 
00* 

starting  =  TRUE"/.* 
WINDOW  OUTPUT  3* 
WINDOW  CLOSE  4* 
END  IF* 

IF  menuitem  =  5  THEN* 
WINDOW  4, "" ,  (0,0) -(300, 40) ,  18, 1: WINDOW  OUTPUT  4* 
INPUT  "Filename  For  Save" ;fil** 
WINDOW  OUTPUT  3  :  WINDOW  CLOSE  4* 
IF  fil*<>""  THEN  GOSUB  savepic* 
END  IF* 

IF  menuitem  =  6  THEN  pause  =  TRUE"/.* 
IF  menuitem  =  7  THEN  pause  =  FALSE"/.* 
IF  menuitem  =  S  THEN* 
WINDOW  4,  ""si  (0,0) -(250,  50),  18,1:  WINDOW  OUTPUT  4* 
PRINT  "Are  You  Sure  You  Want ": PRINT"  To  Erase  the 
Screen?"* 
INPUT  a** 

WINDOW  OUTPUT  3  :  WINDOW  CLOSE  4* 

IF  UCASE*(LEFT*(a*,  1))=,,Y"  THEN  CLS  :  starting  * 
TRUE     * 
END  IF* 

IF  menuitem  =  9  THEN* 
WINDOW  4, "", (0,0) -(250,50) , 18, 1  :  WINDOW  OUTPUT  4 

PRINT  "Are  You  Sure  You  Want  To  Quit?"* 
INPUT  a$* 

IF  UCASE*(LEFT*(a*,l) )="Y"  THEN  GOTO  NoMore* 
WINDOW  OUTPUT  3  :  WINDOW  CLOSE  4  * 
END  IF  * 


END  IF  * 
RETURN* 
* 
savepi.  c ;:  * 

rast port&  =:::  WINDOW (8) * 

bitmap^  =  PEEKL (rastportk+4) * 

top Line  =  0* 

t  op  a d  d  =  t  op  L  i  n e  *  4 0* 
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FOR  17.  =  0  TO  4* 

pLane&(17.)  =  PEEKL  (bi  tmap&  +  S  +  i  7.*4> +topadd* 
NEXT* 

b  o  t 1  q  cr»  L  i.  n  e  ~    2  0  0  * 
L  i  n  e  s  ---  b  o  1 1  o  m  L  i  n  e  ••-•  t  o  p  L  i  n  e  * 
OPEN  fil*  FOR  OUTPUT  AS  1* 
a*  ==  MKL* (Lines  *  40  *  5  +  144)* 
PR I NT# 1 , " FORM " 5  a*  5 " I LBMBMHD " ; MKL* <  20 )  ;  * 
PRINTttl  ,, MKI* (320) ; MKI* (Lines) ; MKL* (0) ; * 
PR  I  NT#  1 ,  CHR*  ( 5 )  ;  MK I  *  <  0 )  5  CHR*  <  0 )  ;  * 
PR  I  NT#  1 ,  Ml<  I  *  ( 0 )  ;  CHR*  (10)  ;  CHR*  (11):* 
PR  I  NT#  1  s,  MK  I  *  ( 320 )  ;  MK  I  *  ( 200 )  :  * 
PR  I  NT#  1  h  "  CMAP  "  3  MKL*  ( 96 )  ;  * 
FOR  17.  =  0  TO  31* 

PR  I  NT#  1 ,  cmap*  (  i  7.)  ;  * 
NEXT* 

PRINTttl,  "BODY"  3  MKL*  (Lines  *  40  *  5);* 
FOR  17.  ~  1  TO  Lines* 

FOR  p7.  =  0  TO  4* 
FOR  j7.  =  0  TO  39  STEP  4* 

PRINT#1  ,  MKL*  (PEEKL  (pLanek  <p7.)  +  j7.)  )  ;  * 
NEXT  jT.* 
p  L  a  n  e  &  ( p  7. )  ™  p  Lane  &  ( p  7. )  +  4  0  * 

NEXT  p7.* 
NEXT  17,* 
CLOSE* 

PALETTE  0, 1, 1, Is  SOUND  440, 20, 200, 0: PALETTE  0,0,0,0< 
RETURN* 

NoMores * 
WINDOW  CLOSE  3  :  WINDOW  CLOSE  4  5  SCREEN  CLOSE  1* 
MENU  RESETS- 
MENU  OFF* 
END* 
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3-D  Surfaces 

Martin  Staley 


Written  entirely  in  Amiga  Basic,  this  graphically  im- 
pressive program  allows  you  to  plot  three-dimensional 
shapes  on  the  screen  in  any  color  combination  you 
like.  By  making  smaiJ  changes,  you  can  view  the  ob- 
ject from  any  vantage  point  or  plot  an  entirely 
different  graph. 

One  of  the  most  popular  traditional  applications  for  computer 
graphics  is  to  plot  three-dimensional  graphs  on  the  screen. 
That  description  may  sound  dull,  but  the  resulting  shapes  are 
often  quite  beautiful  in  their  own  right  as  well  as  educational. 
The  Amiga's  outstanding  graphics  capabilities  and  fast  pro- 
cessing speed  make  it  ideal  for  such  activity. 

"3-D  Surfaces"  provides  a  convenient,  powerful  tool  for 
anyone  interested  in  creating  such  pictures.  It  draws  3-D 
graphs  as  mesh  perspectives.  That  is,  the  shapes  appear  as  rec- 
tangular grids  that  have  been  pushed  up  or  down  in  various 
places  to  create  a  variety  of  different  shapes.  The  program 
permits  you  to  change  many  different  aspects  of  the  picture, 
including  the  fineness  of  the  mesh,  screen  resolution,  observa- 
tion angle,  low  and  high  bounds  of  the  function  that  creates 
the  picture,  and,  of  course,  the  function  itself. 

Type  in  and  save  the  program.  Since  the  program  requires 
quite  a  bit  of  memory,  it's  best  not  to  run  any  other  programs 
while  it's  in  operation. 

Using  the  Program 

The  program  begins  by  computing  all  the  data  it  needs  to  plot 
the  current  function.  This  process  can  take  awhile,  depending 
on  the  complexity  of  the  shape.  To  inform  you  of  its  progress, 
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the  program  prints  a  counter  value  on  the  screen.  When  the 
calculations  are  complete,  the  program  draws  the  shape  on  the 
screen. 

Once  the  shape  is  finished,  you  can  change  any  of  the 
screen  colors  by  moving  the  color  sliders  in  the  upper  left  cor- 
ner of  the  screen  with  the  mouse  pointer.  To  move  a  slider, 
place  the  mouse  pointer  on  the  slider,  hold  down  the  left 
mouse  button,  and  then  move  the  slider  to  the  desired  spot. 

You  can  stop  the  program  if  necessary  by  selecting  the 
Quit  option  from  the  Actions  menu.  This  option  automatically 
restores  the  original  palette  colors  and  closes  the  hi-res  screen 
for  your  convenience. 

Creating  New  Shapes 

This  program  is  designed  to  give  you  great  flexibility  in  plot- 
ting your  own  3-D  pictures.  Apart  from  color  changes  (see 
above),  this  is  done  by  changing  one  or  more  of  the  param- 
eters defined  at  the  beginning  of  the  program.  The  best  way  to 
learn  about  these  parameters  is  to  experiment  on  your  own. 
All  of  the  controlling  parameters  are  located  immediately  fol- 
lowing the  labels  Parameters  and  Equation.  If  you're  familiar 
with  this  type  of  activity,  the  comments  in  these  lines  may 
give  you  enough  information  to  plot  your  own  graphs.  The  re- 
mainder of  this  article  discusses  in  more  detail  the  significance 
and  use  of  these  parameters. 

Change  the  Equation 

Each  image  created  by  this  program  is  a  two-dimensional 
representation  of  an  equation  or  a  mathematical  function.  It  is 
the  equation,  more  than  any  other  factor,  which  controls  the 
ultimate  appearance  of  the  graph.  It's  defined  with  the  DEF 
FN  statement  in  the  line  immediately  after  the  label  Equation. 
DEF  FN,  as  you  may  know,  creates  a  user-defined  function  for 
later  use  in  the  program  in  which  it  appears.  To  change  the 
function,  simply  replace  the  portion  on  the  right  side  of  the 
equal  sign  (  =  ).  The  result  can  be  an  entirely  new  shape.  Here 
are  some  interesting  functions  to  try: 
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4 

4 

4 

<x^2+5*y^2) *EXP ( l-x^2-y^2) /2-SIN (3*x~2y^2) / <x^2+y^2> 

4 

4 

-x^3/10-(SIN(l-x^2-y^2)+COS(l-x^2--y^2)  )  /24 

4 

SIN(3*x)*SIN(3*y)/5+-7*SIN(2*x^2+3*y^2)/(x^2+y^2)4 

4 

COS  <3*x ) +2*SIN (x^2+y^2> / (x^2+y^2> -x/24 

4 

-  3* (SIN (x^2+y> +COS (y^2+x ) ) 4 

4 

(SIN (4*x^2+y~2) +2*SIN (x  *y) ) / <4*x^2+y~2>  4 

4 

SIN(3*x)+SIN(3*y)4 

4 

4 

4 

In  each  case,  the  new  function  definition  should  be  substi- 
tuted for  the  portion  of  the  DEF  FN  statement  that  lies  on  the 
right  side  of  the  equal  sign.  For  instance,  to  use  the  last  ex- 
ample definition,  the  line  following  the  label  Equation  should 
read  as  follows: 

DEF  FNz(x,y)  =  SIN(3*x)  +  SIN(3*y) 

The  Plot  Thickens 

The  first  two  variables  in  the  Parameters  section,  m  and  n,  con- 
trol the  number  of  grid  rectangles  in  the  x  (horizontal)  and  y 
(vertical)  directions.  Simply  put,  these  values  control  the  fine- 
ness of  the  rectangular  mesh  of  which  the  graph  is  composed. 
If  you  increase  the  value  of  m  and/or  n,  the  plot  appears 
thicker  and  more  finely  detailed.  The  finer  the  resolution,  the 
better  the  graph  looks.  However,  more  detailed  plots  take 
longer  to  create.  Conversely,  smaller  values  make  the  graph 
look  coarser  and  less  substantial.  The  coarser  the  mesh,  the 
less  time  it  takes  to  complete  the  necessary  calculations.  Set- 
ting both  values  to  31  is  a  reasonable  tradeoff  between  time 
and  accuracy. 

Since  the  program  utilizes  two  2-dimensional  arrays  based 
on  m  and  n,  the  values  of  these  two  variables  are  limited  by 
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the  amount  of  available  memory.  On  a  512K  Amiga,  I've  used 
values  as  high  as  75.  At  this  degree  of  accuracy,  the  program 
requires  about  ten  minutes  for  calculations;  however,  the  re- 
sults are  worth  it. 

The  values  of  m  and  n  need  not  be  equal.  However,  they 
should  be  set  to  an  odd  number.  Both  of  these  points  are  dis- 
cussed in  more  detail  below. 

Resolution 

The  next  variable,  res,  controls  the  screen  resolution.  If  res 
equals  1,  the  program  draws  the  graph  on  Amiga  Basic's  de- 
fault 640  X  200  output  window.  If  you  set  res  to  2,  the  pro- 
gram opens  a  custom  output  window  in  640  X  400  resolution 
before  it  draws.  The  memory  requirements  of  this  window 
make  it  unusable  on  a  256K  Amiga.  Graphs  drawn  in  the 
lower  resolution  always  look  coarser  than  those  drawn  in  the 
highest  resolution,  particularly  when  the  mesh  size  is  small. 
However,  even  lower  resolution  screens  look  quite  good. 

Accuracy 

The  variable  gt  stands  for  graph  type.  It  controls  the  accuracy 
of  the  plot  by  selecting  one  of  two  drawing  algorithms  (formu- 
las). The  first  algorithm  draws  a  good  estimate  of  the  shape. 
The  second  algorithm  draws  the  shape  in  actual,  exact  per- 
spective from  any  direction,  angle,  and  distance.  Each  method 
has  advantages  and  disadvantages.  The  estimate  method  is 
less  complex,  more  reliable,  and  faster.  The  exact  perspective 
method  is  slower  and  requires  many  more  intensive  calcula- 
tions (which  can  lead  to  error  messages  on  rare  occasions). 
However,  drawing  in  exact  perspective  allows  you  to  view  a 
shape  from  different  observation  points.  The  estimate  method 
causes  some  inaccuracy  in  the  vertical  scale,  but  exact  perspec- 
tive uses  correct  proportions,  taking  into  account  the  fact  that 
pixels  (dots)  on  the  Amiga  screen  are  square,  not  round. 

Aspect  and  Height 

Two  of  the  parameter  variables  are  used  only  with  the  esti- 
mate drawing  method  (see  preceding  section).  The  variable  asp 
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controls  the  apparent  x-y  ratio  of  the  graph  as  it  appears  on 
the  screen,  regardless  of  the  bounds  you  specify.  Aspects  that 
are  too  large  or  too  small  (say,  larger  than  4  or  smaller  than 
Vi)  have  the  side  effect  of  downgrading  the  quality  of  the  esti- 
mate (the  graph  may  look  slightly  distorted).  The  variable  h 
controls  the  height  factor,  which  affects  the  graph's  vertical 
appearance.  In  general,  height  factors  of  less  than  100  tend  to 
make  the  apparent  observation  point  higher  in  the  z  direction; 
as  a  result,  graphs  look  a  bit  stubbier  than  expected.  Larger 
height  factors  have  the  opposite  effect  (lower  observation 
points  and  taller  graphs).  By  enlarging  the  height  factor,  you 
can  emphasize  a  graph's  vertical  qualities. 

Observation  Angle  and  Distance 

The  graph's  perspective  is  controlled  by  three  parameter  vari- 
ables: theta,  phi,  and  d.  The  variable  theta  equals  the  observa- 
tion angle  from  the  x-y  axis  moving  counterclockwise  in  the  x- 
y  plane  as  viewed  from  the  positive  z  direction.  The  variable 
phi  is  the  observation  angle  with  respect  to  the  x-y  plane.  This 
variable  is  set  up  for  both  angles  to  be  in  degrees;  if  you 
would  rather  use  radians,  remove  the  conversions  in  the  sec- 
ond program  line  under  the  label  Equations.  Any  observation 
angle  is  possible  if  you  keep  theta  in  the  range  —180  to  180 
and  keep  phi  in  the  range  —90  to  90.  Other  values  may  be 
used;  however,  it's  usually  best  to  keep  the  angle  more  than 
about  one-tenth  degree  away  from  any  positive  or  negative 
multiple  of  90  degrees  (including  0)  to  avoid  overflow  errors 
in  the  computation.  Such  extreme  observation  angles  aren't 
very  interesting,  anyway,  since  you  tend  to  lose  most  of  the 
graph's  three-dimensional  quality. 

The  variable  d  controls  the  distance  of  the  observation 
point — in  the  direction  of  the  direction  angles — from  the 
graph's  center  (the  point  whose  coordinates  are  the  average  x, 
y,  and  z  coordinates  of  all  the  computed  function  values).  The 
only  formal  restriction  for  d  is  that  it  cannot  be  0.  However,  it 
should  be  large  enough  to  place  you  a  reasonable  distance 
from  the  shape.  Observing  the  graph  from  an  extremely  close 
location  is  a  bit  like  viewing  the  Mona  Lisa  by  putting  your 
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eye  one  millimeter  away  from  the  canvas.  In  addition,  ex- 
tremely small  values  for  d  can  actually  locate  the  observation 
point  "inside"  the  graph.  The  program  assumes  that  all  graph 
points  are  within  a  180-degree  field  of  view  while  looking  to- 
ward the  center.  If  d  is  so  close  to  the  center  that  not  all  of  the 
graph's  points  are  within  this  view,  the  program's  output  is 
garbage.  It's  best  to  make  d  large  enough  so  that  the  observa- 
tion point  is  beyond  the  bounds  of  the  function  as  specified  by 
the  four  parameters  discussed  in  the  next  section.  Incidentally, 
specifying  a  very  large  distance  won't  make  the  graph  look 
significantly  smaller.  As  the  distance  becomes  larger,  perspec- 
tive qualities  such  as  the  presence  of  a  vanishing  point  become 
less  pronounced.  To  avoid  wasting  screen  resolution,  the  pro- 
gram always  stretches  the  perspective  until  either  the  horizon- 
tal or  vertical  dimension  becomes  too  large  to  fit  on  the 
screen. 

Bounds 

The  next  four  parameter  variables  set  the  low  and  high 
bounds  of  the  graph  in  the  x  and  y  dimensions.  This  simply 
means  that  the  four  sides  of  the  graph  will  be  along  those 
edges. 

Equation  Notes 

The  most  important  parameter,  of  course,  is  the  equation  con- 
tained in  the  DEF  FN  statement.  When  defining  new  func- 
tions, keep  in  mind  that  the  computer  can't  perform  some 
operations,  such  as  dividing  by  0  or  taking  the  square  root  of  a 
negative  number.  However,  functions  which  have  what's 
known  as  a  limiting  value  on  the  interval  can  usually  be  plot- 
ted. There  are  many  rational  functions  whose  numerators  be- 
come 0  at  the  same  time  their  denominators  reach  0;  and  the 
ratio  can  be  finite.  But  the  computer  doesn't  know  this  and 
still  generates  a  Division  by  zero  error  unless  it  just  misses  the 
coordinate  in  question. 

To  compute  function  values,  the  program  increments  be- 
tween the  low  and  high  x  bounds,  and  between  the  low  and 
high  y  bounds,  in  step  sizes  such  that  a  total  of  m  + 1  different 
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x  values  and  n  +  1  different  y  values  are  eventually  put  in  the 
equation.  If  the  increment  sizes  and  the  low  and  high  bounds 
are  such  that  the  offending  point  is  skipped,  everything  should 
work  correctly.  Odd  values  for  m  and  n  seem  to  work  best,  but 
problems  are  still  rare  when  even  values  are  used. 

For  some  equations,  the  CLEAR,60000  statement  in  the 
second  program  line  may  cause  an  Out  of  memory  error.  You 
may  be  able  to  avoid  this  error  by  reducing  the  value  in  the 
CLEAR  statement.  That  change  reduces  the  amount  of  space 
available  for  BASIC  arrays  and  variables,  which  may  make  it 
necessary  to  decrease  the  value  of  m  and/or  n  as  well. 

3-D  Surfaces 

Filename:  3DSURF 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

4 

3D  Surfaces* 
*   Copyright  1987  COMPUTE!  Publications,  Inc. 4 

All  Rights  Reserved* 
4 

CLEAR ,  600008c :  DEF I  NT  i  ,  j  4 

pi=3. 1415?27#:e=2.7182818#4 
Parameters:       4 

m=31:n=31  *  mesh  size  =  m*n4 

res=l  '  resolution:  1=640*200,  2=6 

40*4004 

gt=l  "  graph  type:  1 "estimate,  2* 

real      4 

asp=l  '  y/x  ratio  of  graph  (only  f 

or  gt=l>4 

h-150  *  height  factor       (only  f 

or  gt=l)4 

theta=30  : phi =20      *  observation  angles  in  degr 
ees  (only  for  gt=2)4 

d=100  *  distance  from  graph  center 

(only  for  gt=2)4 

lox=-3  :hix=3         *  low  &  high  bounds  in  x  dir 
ection4 

loy«-3  :hiy=3         *  low  &  high  bounds  in  y  dir 
ection4 
Equation:    4 

DEF  FNz (x , y) =SIN (x^2+3*y~2> / (x^2+y^2) + (x^2+5*y~2> 
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*EXP(l-x^2-y~2)/2  4 

theta=theta*pi /180s  phi  »phi  *pi / 180   *  conversi on : 
degrees  to  radians* 

a-d*COS (phi ) *COS (theta) 4 
b»d*COS (phi ) *SIN (theta) 4 
c»d»SIN(phi)       4 
GOSUB  Check4 

DIM  xc(m+l,n+l) ,yc(m+l,n+l)   4 
tx=(hix-lox) /msty^Chiy-loy) /n4 
PRINT:PRINT  "computing  values... "4 
LOCATE  4, 7: PRINT  m+1    4 

IF  gt*l  THEN  GOSUB  Estimate: ELSE  GOSUB  True4 
Draw: 4 

IF  res-2  THEN  SCREEN  1 ,640,400, 2, 4: WINDOW  2, "grap 
h",,15, 1:ELSE  CLS  4 

DIM  v(15),rgb(3,2)4 
p«04 
Re:  4 

FOR  c»0  TO  3  4 

READ  r,g,b:PALETTE  c,r,g,b4 
rgb(c,»)"Br:rgb  (c,  i)  *g:  rgb  (c,2>asb4 
NEXT  c  4 

DATA  0,0,0,. 14,. 14,. 14, 0,0, 0,0, 0,14 
COLOR  2,34 

FOR  x«dfx  TO  dtx   STEP  sx4 
FOR  y»dfy  TO  dty  STEP  sy4 

x  l»xc  (x  ,y)  :x2«xc  (x, y+1 )  :x3=xc  (x+l,y+l )  :x4=*x 
c(x  +  l,y)4 

yl«yc (x ,y) : y2»yc (x,y+l ) :y3»yc (x+l,y+l ) : y4=y 
c<x  +  l,y>4 

AREA  (xl,yl):AREA  (x2,y2):AREA  (x3,y3):AREA 
(x4,y4) :AREAFILL4 

LINE  (xl,yl)-(x2,y2),3:LINE  (x2, y2) - (x3, y3) 
,34 

LINE  Cx3,y3)-(x4,y4),3:LINE  (x4, y4) - (x 1 , yl ) 
,3    4 

NEXT  y4 
NEXT  x    4 
Colors:  4 

FOR  n-0  TO  15:v(n)«ll+7.54*n:NEXT  n4 

col«0:xl«ll:x2«ll:x3=114 

IF  res«l  THEN  WINDOW  3, "colors" , (0,0) -< 130, 50) , 18 

IF  res»2  THEN  WINDOW  3, "colors" , (0,0) -( 130,50) , 18 

WINDOW  OUTPUT  34 

PRINT  "R": PRINT  "G": PRINT  "B" : PRINT: PRINT  "C"4 
LINE  (0,0)-(130,0):LINE  (0, 8) -( 130, 8) 4 
LINE  (0,16)-(130, 16):LINE  (0, 24) - ( 130, 24) 4 
LINE  (10,0)-(10,50):LINE  ( 1 1 , 25) -(40, 50) , 0, bf 4 
LINE  (40, 25) -(70, 50) ,l,bf:LINE  (70,25) -( 100, 50) , 2 
,bf4 
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LINE  (100,25)-(130,50),3,bf :LINE  ( 1 1 ,  1 ) - ( 19, 7) , 3, 
bf    4 

LINE  (ll,9)-(19,15),3,bf :LINE  ( 1 1 ,  17) - ( 19, 23) , 3, b 
f  4 

i=20:LINE  (20, 32) - (30, 42) , 1 , bf 4 

MENU  1,0, 1," Act ion": MENU  1 , 1 , 1 , "Qui t" : MENU  0N4 
Loop : 4 

IF  MENU(0)=1  AND  MENU(1)=1  THEN4 

WINDOW  CLOSE  3: MENU  RESET: SCREEN  CLOSE  1 : ST0P4 

END  IF4 

x=MOUSE(l) :y=M0USE(2):IF  MOUSE (0) >=0  THEN  cl=l:c2 
=l:c3«l:G0T0  Loop4 

IF  x>10  AND  x<131  THEN  IF  y>24  AND  y<51  THEN  Bete 
ol:ELSE  GOTO  Check  14 

GOTO  Loop4 
Checkl:4 

arg=. 1260504*x-l. 386551: IF  y< 1  OR  y>7  OR  cl=0  THE 
N  Check24 

LINE  (11, 1)-(130,7) ,0,bf :LINE  (v (arg) , 1 ) - (v (arg) + 
8,7)  ,  3,bf  :xl=v(arg)4 

*  rgb (col ,0)=arg/ 15: PALETTE  col ,rgb (col ,0) , rgb (col , 
l),rgb(col,2)4 

c 1=1 :c2=0:c3=0: GOTO  Loop4 
Check2:4 

IF  y<9  OR  y>15  OR  c2=0  THEN  Check34 

LINE  (11,9)-(130, 15) ,0,bf :LINE  (v (arg) , 9) - (v (arg) 
+8, 15) ,3,bf :x2=v(arg)4 

rgb (col , 1 ) =arg/ 15: PALETTE  col , rgb (col , 0) , rgb (col , 
l),rgb(col,2)4 

c 1=0: c2=l:c3=0: GOTO  Loop4 
Check3:4 

IF  y<17  OR  y>23  OR  c3=0  THEN  Loop4 

LINE  (11,17)-(130,23) ,0,bf :LINE  (v  (arg)  ,  17)  -  (v  (ar 
g)+8,23) , 3,bf :x3=v(arg)4 

rgb (col , 2) =arg/ 15: PALETTE  col ,rgb (col ,0) , rgb (col , 
1) ,rgb(col,2)4 

c 1=0: c2=0:c3=l: GOTO  Loop4 
Getcol :4 

LINE  (i,32)-(i+10,42),col,bf4 

IF  x<40   THEN  i=20  :LINE  (i , 32) - (30, 42) , 1 , bf  :col 
=0:GOTO  Nst4 

IF  x<70   THEN  i=50  :LINE  (i , 32) - (60, 42) , 2, bf  :col 
=l:GOTO  Nst4 

IF  x<100  THEN  i=80  :LINE  (i , 32) - (90, 42) , 3, bf  :col 
=2: GOTO  Nst4 

i=110:LINE  (i, 32) -(120, 42) ,0,bf : col 
=34 
Nst :    4 

LINE  (11,  1) -(130,23) ,0,bf: LINE  ( 10, 8) - ( 130, 8) :LIN 
E  (10, 16)-(130, 16)4 

c=14 
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FOR  n=0  TO  2:tl=lll*rgb(col ,n)+114 
LINE  (tl  , c)-(tl+8,c+6)  ,  3,bf  :c=c+84 
NEXT  n4 
GOTO  Loop4 
Check:    4 

m=INT(m) :n=INT(n)4 

asp=ABS<asp) :h=ABS<h)4 

IF    resOl    AND    res<>2    THEN    res=14 

IF    res=l    THEN    ht=186: hht=93   4 

IF    res=2    THEN    ht=386: hht=1934 

IF    lox>hix    THEN    SWAP    lox,hix4 

IF    loy>hiy    THEN    SWAP    loy,hiy4 

df x=l : dtx=m: sx=l:df y^l : dty=n: sy=14 

IF  gt<>2  THEN  gt=14 

IF  res<>2  THEN  res=14 

IF  gt=2  THEN4 

IF  a<0  THEN  df x=m: dtx=l : sx=-14 
IF  b<0  THEN  dfy=n:dty=l:sy=-14 
END  IF4 
RETURN       4 
Estimate: 4 

ml«=310/m:m2=160/m:nl=310/n:n2=3160/n:rd=180/pi4 
x=240/SQR ( l+asp^2) : y=240*asp/SQR ( l+asp^2) 4 
spx =3 10+. 8886207* (x-y) : spy=hht-. 4586429* (x+y) 4 
x 1=1 . 777241 *x /m: x2=l . 777241 *y/n: yl=. 9 172858*x /m: y 
2=.9172858*y/n   4 
i=0:x=lox-tx4 
WHILE  i<m+14 

i=i+l   :LOCATE  5,7:PRINT  i;4 
x*x+tx  : j=0: y=loy-ty4 
WHILE  j<n+14 
j=j+14 

y=y+ty  4 

xc(i , j)=(spx+x2*j-xl*i )4 
yc<i , j)=spy+y2*j+yl*i-h*FNz (x,y)4 
IF  yc(i,  jXsmin  THEN  smin=yc  (i  ,  j  )  4 
IF  yc(i, j) >smax  THEN  smax=yc (i , j) 4 
WEND4 
WEND4 

IF  smax<ht  AND  smin>0  THEN  RETURN4 
avg=  <  smax  +smi  n )  /2 :  smax  =smax -avg : smi  n=smi  n-avg : mul 
t=ht/ (smax-smin)4 
FOR  x»l  TO  m+14 

FOR  y=l  TO  n+14 

yc (x,y)*mult*  <yc  <x,y)-avg)+hht4 
NEXT  y4 
NEXT  x    4 
RETURN4 
True: 4 

DEF  FNc(a,b,c,x,y,z>=(x*(b*<b-y)+c*(c-z) >+<x-a)*< 
b*y+c*z> )/d4 
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DEF   FNang  (x , y , z ) - (px *x+py*y+pz*z ) / (dp*SQR (x^2+y^2 
+z^2) )  4 

px*FNc(a,b,c,0,0, 10) : py=FNc (b, a, c, 0,0, 10) :pz=FNc ( 
c,b9a, 10,0,0)4 

dp-SQR (px^2+py~2+pz~2) 4 
i«0: x=lox-tx4 
WHILE  i<m+14 

i«i+l   :LOCATE  5,7:PRINT  14 
x^x+tx  : j=0:y=loy-ty4 
WHILE  j<n+14 
j=j+14 

y=y+ty  4 

xc (i , j)=FNz (x,y) :sum=sum+xc (i  f  j)4 
WEND4 
WEND4 

avg«Bum/ ( (m+1 ) * (n+1 ) ) : ym=loy-ty- (loy+hiy) /24 
i»0:x-lox-tx-(lox+hix) /24 
WHILE  i<m+14 

i«i  +  l   :LOCATE  6,7:PRINT  14 
x=x+tx  :j=0:y«ym4 
WHILE  j<n+14 

jB!j  +  l:y=y+ty:z=xc  (i  ,  j)-avg  4 

d=a* (a-x ) +b* (b-y ) +c* (c-z ) 4 

xc=FNc (a,b,c,x,y,z)4 

yc*FNc (b,a,c,y,x,z)4 

zc=FNc (c,b,a,z,y,x)4 

rad=SQR (xc^2+yc^2+zc^2) 4 

s=14 

IF  SGN(a)OSGN(yc*pz-zc*py)  THEN  4 

s=-14 
ELSEIF  SGN<b)OSGN<zc*px-xc*pz)  THEN  4 

s«-14 
ELSEIF  SGN(c)OSGN(xc*py-yc*px)  THEN  4 

s=-14 
END  IF4 

cs**FNang  (xc ,  yc ,  zc)  :  sn=SQR  ( 1 .  00001-cs^2) 4 
xc (i , j >=s*rad*sn:yc (i , j)=-rad*cs  4 

IF  xc (1 , j) >xmax  THEN  xmax=xc  (i  ,  j  )  4 
IF  xc(i,  jXxmin  THEN  xmin=xc (i , j ) 4 
IF  yc(i, j)>ymax  THEN  ymax=yc  (i , j ) 4 
IF  yc(i,j)<ymin  THEN  ymin=yc (i , j ) 4 
WEND4 
WEND4 

ax»(xmax+xmin) /2:ay= (ymax+ymin) /24 
IF  res=l  THEN4 
hzy=934 
IF  ( (ymax-ymin) / (xmax-xmin) ) >(6. 75/10. 25)  THEN 


8994 
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Graphics 


my=602/ (xmax-xmin) /2. 200899: mx=602/ (xmax-xm 
in)4 

END  IF4 
ELSE    4 

hzy=1934 

IF  ( (ymax-ymin) / (xmax-xmin) ) >(6. 875/10. 25)  THE 


N4 
0894 


in)4 


my=368/ (ymax-ymin) :mx=368/ (ymax-ymin) *  1.092 

ELSE4 

my=602/ (xmax-xmin) /l . 092089: mx =602/ (xmax-xm 


END  IF4 
END  IF4 
FOR  x=l  TO  m+14 

FOR  y=l  TO  n+14 

xc  (x,y)as315+mx*  (xc  (x,y)-ax)4 
yc (x , y) ^hzy+my* (yc (x , y ) -ay ) 4 
NEXT  y4 
NEXT  x    4 
RETURN4 
4 
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System  Fonts 

Daniel  L.  Stockton 


This  short  program  illustrates  how  to  select  different 

system  fonts  and  text  styles  under  program  control  in 

Amiga  Basic. 


Nearly  every  Amiga  owner  recognizes  that  there  are  two  sys- 
tem text  fonts.  If  you  open  the  Preferences  tool,  you  can 
switch  between  the  80-column  font,  actually  called  Topaz 
Eight  Point,  or  the  60-column  font,  called  Topaz  Nine  Point. 
The  font  which  you  select  from  Preferences  is  carried  over 
when  you  activate  Amiga  Basic.  Many  Amiga  Basic  programs 
are  written  with  the  assumption  that  you  have  selected  one 
font  or  the  other — either  Topaz  Eight  or  Topaz  Nine.  If  you 
run  a  program  only  to  find  that  printing  is  not  aligned  cor- 
rectly, the  cause  is  usually  that  you're  using  the  wrong  font. 
The  only  remedy  is  to  exit  BASIC,  open  Preferences,  select  the 
other  font,  and  run  the  program  all  over  again. 

In  fact,  there's  no  need  to  make  users  play  "guess  the 
font"  when  they  run  Amiga  Basic  programs.  With  a  relatively 
simple  system  call,  you  can  select  either  of  the  system  fonts 
under  program  control.  And  the  same  system  call  can  be  used 
to  select  special  text  styles,  including  boldface,  italics,  and  un- 
derlining. The  subprogram  included  with  this  article  makes  it 
all  easy  to  do. 

Opening  the  Library 

To  change  fonts  under  program  control,  you  must  make  a  call 
to  operating  system  routines.  A  group  of  system  routines  is 
known  as  a  library;  the  particular  library  which  we  need  is 
called  graphics. library.  The  door  to  the  library  is  opened  with 
the  BASIC  statements  LIBRARY  and  CALL. 

Type  in  the  program  and  save  it.  Before  you  run  the  pro- 
gram, you  must  make  sure  that  a  special  system  file  is  on  your 
BASIC  work  disk.  When  BASIC  executes  the  LIBRARY  com- 
mand in  this  program,  the  Amiga  looks  for  a  file  named 
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graphics.bmap  which  enables  it  to  locate  graphics.library 
routines.  If  graphics.bmap  can't  be  found,  the  computer  dis- 
plays an  error  box. 

Users  of  Workbench  1.2  should  follow  the  procedure  out- 
lined in  Appendix  B  for  creating  the  graphics.bmap  file. 

The  simplest  way  for  users  of  Workbench  1.1  to  make 
sure  that  graphics.bmap  can  be  found  is  to  copy  it  from  the 
BasicDemos  drawer  (subdirectory)  of  your  Extras  disk  to  the 
LIBS  subdirectory  of  your  BASIC  work  disk.  Enter  these  com- 
mands to  perform  the  copy  from  the  CLI: 

COPY  Extras:BasicDemos/graphics.bmap  TO  ram: 
COPY  ram:graphics.bmap  TO  Workbench:libs 
DELETE  ram:graphics.bmap 

These  commands  assume  that  your  BASIC  work  disk  is 
named  Workbench.  If  it  is  not,  substitute  your  disk  name  for 
Workbench  in  the  second  AmigaDOS  command.  (If  the  disk 
name  contains  a  space,  you  must  enclose  that  portion  of  the 
command  in  quotation  marks.  For  example,  if  your  work  disk 
is  named  BASIC  Programs,  then  the  command  will  be  COPY 
ram:graphics.bmap  TO  "BASIC  Programs:libs".)  When  it  en- 
counters LIBRARY  in  a  program,  the  computer  automatically 
searches  the  LIBS  subdirectory  for  the  designated  file. 

Another  way  to  ensure  access  to  the  .bmap  file  is  to  use 
CHDIR  before  the  LIBRARY  statement.  CHDIR  can  be  used  to 
specify  a  particular  subdirectory  as  the  current  directory  for 
DOS  access.  If  you  create  a  subdirectory  devoted  exclusively 
to  .bmap  files,  then  every  program  can  perform  a  CHDIR  to 
that  directory  before  attempting  a  LIBRARY  command.  One 
advantage  of  the  second  method  is  that  it  avoids  unnecessary 
duplication  of  .bmap  files  in  a  case  where  you  keep  BASIC 
programs  in  more  than  one  subdirectory  on  a  disk. 

Styles 

Once  graphics.bmap  is  located  in  the  correct  place,  load  and 
run  the  program.  It  prints  eight  different  text  styles  in  each  of 
the  two  system  fonts.  The  variable  style°/o  controls  which  style 
is  selected.  Table  7-1  contains  explanations  of  the  different 
values  assigned  to  that  variable. 
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Table  7-1.  The  Values  for  the  style%  Variable 


styleVo  Value 

Result 

0 

plain  text 

1 

underlined 

2 

boldface 

3 

boldface,  underlined 

4 

italics 

5 

italics,  underlined 

6 

italics,  boldface 

7 

italics,  boldface,  underlined 

The  subprogram  named  FontChange  is  designed  to  be 
merged  with  your  own  programs.  Once  you  know  that  the 
demonstration  works  correctly,  you  can  delete  everything  but 
the  FontChange  subprogram  and  save  it  in  ASCII  form  (type 
SAVE  //FontChange,,,A  and  press  RETURN).  You  can  then 
add  it  to  another  program  with  a  MERGE  command. 

System  Fonts 

Filename:  SYSFONTS 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

?  Copyright  1987  Compute!  Publications,  Inc. 4 

'  All  Rights  Reserved* 

* 

REM  The  next  three  lines  must  be  in  the  main  body 
of  your  program* 

REM  and  occur  before  any  calls  to  subroutine  FontC 
hanger* 
* 

DECLARE  FUNCTION  AskSof tStylefc  LIBRARY* 
DECLARE  FUNCTION  OpenFontfc  LIBRARY* 

REM   Place  optional  CHDIR  command  here  to  point  to 
the* 

REM   graphics. bmap  file  directory  as  next  line  exa 
mple: * 

REM   CHDIR  "ABC:D"* 

REM   which  points  to  volume/disk  ABC  directory  D* 
LIBRARY  "graphics. library"* 

* 

REM   The  format  for  a  CALL  to  FontChange  is:* 

REM        CALL  FontChange  (  "topaz  .  font " ,  height'/.,  st 
yle"/.)* 

REM        "topaz. font"  is  the  name  of  the  system  f 
ont* 

REM        heights  is  a  short  integer  variable  to  b 
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as 

8  or  94 

sty  ley. 

is  a  short  integer  variable 

as 

0  through  7  4 

e  selectecK 

REM 

REM        style*  is  a  short  integer  variable  to  be 
selected  4 

REM 

4 

REM   The  nine  lines  o-F  Testit  below  are  for  testin 
g  only4 

REM   and  should  be  replaced  by  your  appl ication (Th 
e  main  body4 

REM   of  your  program) -4 

4 

Testit:4 

CLS4 

FOR  height"/.=8  TO  94 
FOR  style"/.=0  TO  74 

CALL  FontChange  (  "topaz  .  font",  height/.,  sty  leX)  4 
PRINT   "This  is  the  topaz  font  of  height  ";hei 
ght7.;M  style  ";styley.4 
NEXT  style"/.4 

NEXT  heighf/.4 

CALL  FontChange  ( "topaz . f ont ", 8, 0) 4 

REM  The  library  should  be  closed  when  no  longer  re 
quired4 

4 
LIBRARY  CL0SE4 
END4 
4 

REM   The  subroutine  FontChange  should  be  placed  at 
the  bottom4 

REM   of  your  program  after  the  END  statement4 

4 
SUB  FontChange  (font*,  height'/.,  style*)  STATIC4 

SHARED  pFont&4 

IF  pFont&<>0  THEN  CALL  CloseFont (pFontfc) 4 

f ont AS=f ontS+CHRS (0)4 

tex tAttrfc  (0)  =SADD  (f  ontAS)  4 

textAttr&(l)=heighty.*65536&  +  style"/.*256  4 

pFont&=OpenFont&  ( VARPTR  (textAttr*  (0)  )  )  4 

IF  pFontfc  <>  0  THEN  SetFont  WINDOW (8) , pFont&4 

permi  f/.=AskSof  tStyl e«c  (WINDOW  (8)  )  4 

SetSoftStyle  WINDOW  (8)  ,  style-/.,  permi  f/.4 
END  SUB4 
4 
4 
4 
4 
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Daniel  L.  Stockton 

"Disk-Based  Fonts"  is  an  expansion  of  the  previous 
article  "System  Fonts."  Here  we  explore  Amiga  fonts 

even  further.  Also,  you'll  learn  techniques  to  create 
your  own  customized  DISKFONT.BMAP  file.  The  ac- 
companying program  shows  how  to  load  custom  text 
fonts  from  disk  and  use  them  from  Amiga  Basic. 

In  the  Utilities  drawer  of  the  Amiga  Workbench  disk  is  a  use- 
ful tool  called  Notepad.  One  attractive  feature  of  this 
mini-word  processor  is  its  ability  to  use  a  variety  of  text  fonts. 
This  article  explains  how  to  use  those  same  fonts — or  any 
disk-based  text  font — in  Amiga  Basic.  Amiga  Basic  does  not 
provide  any  direct  means  of  loading  a  custom  font  from  disk. 
However,  this  can  be  accomplished  by  calling  system  routines 
which  are  used  by  the  computer  itself. 

Where  Are  My  Fonts? 

The  fonts  used  by  Notepad  are  located  in  the  Fonts  directory 
of  the  Workbench  disk.  You  can  use  the  FILES  command  to 
get  a  listing  of  that  directory.  Type  this  command  in  the 
BASIC  output  window  and  press  Return: 

files  "Workbench-.Fonts" 

Each  font  in  the  Fonts  directory  has  its  own  subdirectory 
which  contains  the  various  sizes  for  that  font.  Font  sizes  are 
specified  in  units  called  points,  which  are  equal  to  1/72  inch. 
Thus,  a  9-point  font  has  characters  9/72  inch  in  size,  and  so 
on.  The  different  text  styles  (italicized,  boldface,  and  so  on)  are 
not  stored  in  the  font  directory;  these  styles  are  generated  by 
selectively  distorting  the  shapes  found  in  the  basic  font  file. 

The  program  included  with  this  article  can  select  any  of 
the  disk-based  fonts,  with  eight  styles  for  each  font.  Table  7-2 
lists  the  fonts,  and  Table  7-3  lists  the  various  styles.  Version 
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1.2  of  the  Amiga  operating  system  adds  a  few  new  sizes  to  ex- 
isting fonts. 

Table  7-2.  Font  Sizes 


Fonts 

Sizes 

Topaz 

8,  9,  11 

Ruby 

8,  12,  15 

Diamond 

12,  20 

Opal 

9,  12 

Emerald 

17,  20 

Garnet 

9,  16 

Sapphire 

14,  19 

Table  7-3. 

Font  Styles 

Number 

Style 

0 

plain  text  (Workbench  default) 

1 

underline 

2 

boldface 

3 

boldface  and  underline 

4 

italics 

5 

italics  and  underline 

6 

italics  and  bold 

7 

italics,  bold,  and  underline 

The  program  uses  two  system  libraries  named 
graphics.library  and  diskfont.library.  In  order  for  Amiga  Basic 
to  use  these  libraries,  it  must  have  a  file  description  of  the  li- 
brary in  a  form  which  it  understands.  This  form  is  called  a 
.bmap  file.  The  .bmap  file  is  essentially  a  list  of  pointers  that 
allow  BASIC  to  access  library  routines. 

Before  you  can  run  Disk-Based  Fonts,  you  must  make  sure 
that  the  correct  .bmap  files  are  present  on  the  same  disk  as 
Disk-Based  Fonts.  The  first  such  file,  graphics.bmap,  is  in- 
cluded in  the  BASICDemos  drawer  of  the  Amiga  Extras  disk. 
The  second  file,  named  diskfont.bmap,  must  be  created. 

If  you  have  version  1.2  of  the  Amiga  operating  system 
(available  as  an  inexpensive  upgrade  from  any  Amiga  dealer), 
you  can  create  diskfont.bmap  quite  easily.  The  BASICDemos 
disk  for  1.2  contains  a  BASIC  program  named  ConvertFd,  as 
well  as  a  directory  named  FD1.2.  Run  the  ConvertFd  program, 
using  the  file  named  diskfont.lib_fd.  When  the  program  is  fin- 
ished, the  disk  contains  diskfont.bmap.  If  you  haven't  ob- 
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tained  the  1.2  upgrade,  type  in  and  run  Program  2  from  the 
article  "Banner  Printer/'  page  149.  That  program  reads  values 
from  DATA  statements,  checks  them  for  accuracy,  and  creates 
diskfont.bmap  on  the  current  disk. 

Before  you  run  the  program  Disk-Based  Fonts,  make  sure 
it  is  on  the  same  disk  as  both  graphics.bmap  and 
diskfont.bmap.  The  location  of  these  files  is  important.  They 
must  be  either  in  the  current  directory  or  in  the  directory 
named  LIBS  on  the  disk  used  when  you  booted  the  system. 
The  LIBS  (LIBrarieS)  directory  is  a  good  place  for  .bmap  files, 
since  their  purpose  is  to  give  you  access  to  libraries.  If  you 
don't  have  the  .bmap  files  in  the  correct  place,  BASIC  will 
stop  with  a  File  not  found  error. 

When  you  run  the  program,  it  displays  the  various  fonts 
on  the  screen  in  different  sizes  and  waits  for  you  to  click  the 
mouse  button  before  proceeding  to  the  next  font. 

The  most  important  part  of  the  program  is  contained  in 
the  subprogram  named  FontSelect,  which  appears  at  the  end 
of  the  program.  After  you  have  tested  the  program  and  have 
saved  a  copy,  delete  everything  in  the  program  except  the 
FontSelect  subprogram.  Then  save  the  subprogram  under  a 
new  name  as  an  ASCII  file,  so  that  it  can  be  MERGEd  with 
other  programs.  To  save  a  program  in  ASCII  form,  add  the 
characters  ,a  to  the  end  of  a  normal  save  command.  For  in- 
stance, to  save  the  subprogram  with  the  name  FontSelect,  you 
would  type  this  command  in  the  BASIC  output  window  and 
press  Return: 

save  "FontSelect",a 

The  FontSelect  subprogram  is  invoked  with  a  CALL  state- 
ment in  the  main  program.  Three  items  of  information  are 
passed  to  FontSelect  in  the  form  of  variables. 

The  first  variable  is  a  string  named  font$.  This  string  con- 
tains the  name  of  the  font  you  wish  to  use  (Garnet,  Ruby,  and 
so  on).  If  the  string  is  a  null  string  ("  ",  a  string  containing  no 
characters),  only  a  style  change  occurs. 

The  second  and  third  variables  passed  to  FontSelect  are 
numeric  variables  of  the  short  integer  type.  The  variable 
height°/o  defines  the  point  size  that  you  wish  to  use  (see  Table 
7-2),  and  style°/o  defines  the  style  to  use  (Table  7-3). 

221 


CHAPTER  SEVEN 


Opening  and  Closing  Libraries 

A  few  additional  statements  are  needed  to  prepare  for  the 
CALL  to  FontSelect  and  to  clean  up  afterward.  The  prepara- 
tory statements  are  grouped  together  at  the  beginning  of  the 
program,  immediately  after  the  first  two  REMark  statements. 
The  DEFLNG  statement  causes  all  simple  variables  to  default 
to  the  long  integer  type.  (Note  that  this  declaration  is  overrid- 
den by  the  short  integer  type  specifier  attached  to  height°/o  and 
style%.) 

The  LIBRARY  and  DECLARE  FUNCTION  statements  ac- 
tually give  you  access  to  library  routines.  These  statements 
should  appear  in  the  initialization  section  of  the  program, 
before  the  first  CALL  to  the  FontSelect  subprogram. 

When  the  program  is  about  to  terminate,  you  should  take 
some  additional  steps  to  close  the  fonts  and  the  libraries.  The 
CALL  to  the  CloseFont  function  closes  any  fonts  that  were 
previously  opened.  (A  bug  in  version  1.1  of  the  operating  sys- 
tem prevents  this  CALL  from  working  correctly.  Version  1.2 
corrects  the  bug.  If  you  have  version  1.1,  omit  the  line  con- 
taining the  CALL  to  CloseFont  or  put  a  REM  in  front  of  the 
line.) 

The  final  CALL  to  FontSelect  resets  the  font  to  the  system 
font,  Topaz.  While  not  absolutely  necessary,  it's  considered 
good  manners  for  programs  which  change  the  computer  envi- 
ronment to  restore  the  original  environment  as  closely  as  pos- 
sible before  terminating. 

The  LIBRARY  CLOSE  statement  closes  libraries  that  were 
previously  opened.  If  you  omit  these  final  housekeeping 
chores,  the  computer  may  not  crash,  but  the  libraries  will  re- 
main open,  wastefully  occupying  memory  which  would  other- 
wise be  freed  for  other  tasks. 

The  program  module  named  TestSection  uses  another 
system  routine  named  text  when  printing  words  in  boldface 
and  italicized  styles.  This  method  prevents  the  characters  in 
those  words  from  overlapping,  as  they  would  if  you  printed 
the  words  with  PRINT. 
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Disk-Based  Fonts 

Filename:  DISKFONTS 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

REM  Copyright  1987  COMPUTE!  Publications,  Inc. 4 

REM  All  Rights  Reserved* 

REM  Program   SelectFont* 

REM  Provides  for  use  of  Amiga  disk  based  fonts  from 

Amiga  Basic* 

PRINT  "Copyright  1987  COMPUTE!  Publications,  Inc. "4 

PRINT  "All  Rights  Reserved"* 

DEFLNG  a-z  'all  variables  default  to  long  int 

eger* 

*  Include  optional  CHDIR  command  here  (CHDIR  " : BMAPS 
">* 

LIBRARY  "diskfont. Library"* 
LIBRARY  "graphics. Library"* 
DECLARE  FUNCTION  OpenDiskFont  LIBRARY* 
DECLARE  FUNCTION  AskSoftStyLe  LIBRARY* 
'the  above  commands  must  be  placed  in  the  main  body 
of  your  program* 
* 
TestSection: * 
BREAK  ON* 

ON  BREAK  GOSUB  Housekeeping* 
READ  tl*,t2** 

FOR  i=0  TO  6   'look  at  7  fonts* 
READ  font*, height"/-* 

CALL  FontSeLect  (font*,  height"/.,  styLe"/.)  * 
FOR  styLe"/.=0  TO  4  STEP  2    'look  at  3  styles  eac 
h* 

CALL  FontSeLect <"",0, st yLeX)* 
IF  styLe"/.=0  THEN* 

LOCATE  1,1:  PRINT   "This  is  the";  height"/.;  "poi 
nt  ";font*;"  font"* 

PRINT   "Click  left  mouse  button  for  the  next 
font"* 

PRINT  tl*:PRINT  t2** 
ELSE  IF  styLe"/.=2  THEN* 

a*="YOU  ARE  LOOKING  AT  BOLD  STYLE"* 
PRINT* 

CALL  text (WINDOW (8) , SADD (a*) , LEN (a*) ) : PRINT* 
ELSE  IF  styLe"/.=4  THEN* 

a*="THIS  IS  ITALICS  STYLE"* 
PRINT* 

CALL  text (WINDOW (8) , SADD (a*) , LEN (a*) ) : PRINT* 
END  IF* 
NEXT  styLe"/.* 

* 
Wai  tForMouse: * 
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IF  NOT  MOUSE (0)  THEN  Wai tFor Mouse* 
CLS4 
'include  the  following  CALL  statement  when  usin 
g  workbench  1.24 

'as  it  closes  -Fonts  and  frees  memory  4 
'CALL  CloseFont (WINDOW (8), fontptr)  4 
NEXT  i4 
4 

Housekeep  i  ng : 4 

CALL  FontSeLect ("topaz", 8,0)   'return  to  default  s 
ystem  font4 

LIBRARY  CL0SE4 
END4 

4 
DATA  ABCDEFGHI JKLMNOPQRSTUVWXYZ0 123456789  !  5>#*7.4 
DATA  abcdef  ghi  j  klmnopqrstuvwxyz^Sc*  ( )  =+\  !  /?<  C  €4 
DATA  topaz, 9, ruby, 12, diamond, 12, opal , 114 
DATA  emerald, 20, garnet, 16, sapphire, 194 
REM  End  Of  Test Sec tion4 
4 

SUB  FontSeLect  (fonts,  height"/.,  styLe7.)  STATIC   4 
IF  font*  <>  ""  THEN4 

textAttr (0) -SADD (f ont*+" . f ont "+CHR* (0) ) 4 
textAttr  ( 1 )  =hei  ghf/.*65536&4 

fontptr-OpenDiskFont (VARPTR (textAttr (0) ) )4 
IF  fontptr  THEN  SetFont  WINDOW (8) , fontptr4 
END  IF4 

permi  ted7.«AskSof  tStyLeSc  (WINDOW  (8)  )  4 
CALL  SetSoftStyle  (WINDOW  (8)  ,  styLeX,  permi  ted"/.)  4 
END  SUB4 
4 
4 
4 
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Data  for  object  images  is  stored  in  individual  files — 
which  can  quickiy  iead  to  an  unmanageable  direc- 
tory. This  utility  provides  a  solution:  Programs  not 

oniy  initialize  faster,  but  they  are  also  easier  to  han- 
dle. Requires  Workbench  1.2. 


The  object  commands  in  Microsoft  Amiga  Basic,  which  allow 
you  to  manipulate  sprites,  vsprites,  and  bobs,  provide  easy  ac- 
cess to  some  of  the  Amiga's  most  powerful  animation  routines. 
However,  you  must  store  the  data  for  each  object  image  in  its 
own,  separate  file.  Thus,  if  your  program  uses  six  objects, 
you'll  have  to  manage  seven  separate  disk  files  (six  object 
files,  plus  the  program  itself).  Before  long,  your  previously 
neat  disk  directory  can  start  looking  like  a  zoo. 

"Zookeeper"  offers  a  neat  solution  to  this  problem  by 
converting  image  definition  files  into  DATA  statements  which 
can  be  part  of  the  main  program.  The  DATA  lines  are  orga- 
nized into  meaningful  sections  with  commentary,  bringing  or- 
der to  the  object  zoo. 

Defining  objects  with  DATA  statements  does  make  the 
program  itself  somewhat  larger.  But  the  advantages  of  this 
method  definitely  outweigh  the  drawbacks.  Only  one  file  need 
be  duplicated  when  exchanging  the  program  with  a  friend, 
and  a  printed  listing  of  the  program  shows  everything  needed 
to  make  it  run  properly.  The  program  also  initializes  faster, 
since  it  simply  reads  DATA  statements  already  in  memory, 
rather  than  seeking  and  loading  separate  files  on  disk.  And,  fi- 
nally, it  eliminates  the  problems  that  can  occur  when  a  pro- 
gram is  not  able  to  load  the  necessary  object  files. 

Using  Zookeeper 

Type  in  Program  1  and  save  a  copy.  Zookeeper  can  handle 
object  definition  files  for  both  sprites  and  bobs,  in  the  format 
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produced  by  the  object  editor  program  on  the  Amiga  Basic  Ex- 
tras disk.  Let's  demonstrate  how  it  works  using  an  example 
image  file  from  the  Extras  disk. 

Before  we  begin  you'll  have  to  create  the  exec.bmap  file. 
See  Appendix  B  for  the  complete  instructions. 

In  the  BASICDemos  drawer  of  the  Extras  disk  is  an  image 
definition  file  named  ball.  Copy  that  file  onto  the  same  disk 
(and  directory,  if  applicable)  where  you  saved  the  Zookeeper 
program. 

Run  Zookeeper  and  enter  the  appropriate  filename  at  the 
prompt.  The  program  then  asks  you  to  enter  the  maximum 
number  of  data  elements  for  each  DATA  statement  (eight  is  a 
good  number).  With  this  information,  Zookeeper  creates  a  text 
file  consisting  of  commented  DATA  statements.  The  DATA 
lines  contain  the  same  information  as  the  image  definition  file. 
This  new  file  has  the  same  filename  as  the  one  which  you  en- 
tered earlier,  with  the  filename  extension  .ZOO.  Thus,  if  you 
are  converting  the  image  file  named  ball,  the  new  file  is 
named  ball.ZOO. 

When  the  .ZOO  file  has  been  created,  the  Zookeeper  pro- 
gram gives  you  the  option  to  delete  the  original  image  defini- 
tion file.  Do  not  delete  anything  at  this  point. 

Demonstration 

After  you  have  created  the  ball.ZOO  file,  type  in  Program  2. 
This  program  will  show  you  how  easy  it  is  to  use  the  new  im- 
age format.  After  you  type  in  and  save  all  the  lines  listed  in 
Program  2,  enter  this  command  in  the  BASIC  Output  window: 

MERGE  "ball.ZOO" 

The  effect  of  this  command  is  to  merge  the  DATA  lines 
from  the  ball.ZOO  file  with  Program  2,  which  is  already  in 
memory.  The  DATA  lines  appear  at  the  end  of  the  current 
program. 

Before  you  run  the  combined  program,  look  at  the  sub- 
routine named  InitPlayer  near  the  end  of  Program  2.  That  rou- 
tine sets  a  variable  named  ByteCount,  which  is  used  to  indicate 
how  many  items  to  read  from  the  DATA  statments.  If  you  ex- 
amine the  comments  at  the  beginning  of  the  ball.ZOO  data, 
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you  will  see  a  comment  indicating  how  many  bytes  this  par- 
ticular set  of  DATA  lines  contains. 

Since  we  knew  in  advance  that  ball. ZOO  would  create 
106  bytes  of  data,  we  were  able  to  use  that  number  in  the 
statement  from  InitPlayer  which  sets  ByteCount.  For  any  other 
image,  however,  that  value  will  be  different.  When  using  these 
routines  to  display  your  own  objects,  you  will  need  to  exam- 
ine the  comment  at  the  beginning  of  the  DATA  lines  and 
modify  the  statement  in  InitPlayer  to  match  the  number 
shown. 

When  you  run  the  demonstration,  notice  how  much  faster 
the  program  begins.  Not  having  to  access  the  disk  drive  is  a 
great  advantage.  Another  advantage  is  easy  accessibility  to  the 
image  data  itself.  To  see  what  we  mean,  find  the  twenty-second 
DATA  number  in  the  ball. ZOO  data  set,  change  that  number 
from  24  to  48,  and  then  rerun  the  program. 

Program  1.  Zookeeper 

Filename:  ZOOKEEPER 

For  instructions  on  entering  these  programs,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

4 

*  ZooKeeper4 

*  Convert  image  definition  files  to  DATA  statements* 

*  Copyright  1987  COMPUTE!  Publications,  Inc. 4 

*  All  rights  reserved -4 

PR I NT "Copyright  1987": PR I NT "Compute !  Publications,  I 

nc."4 

PRINT"A11  Rights  Reserved. ": FOR  X»l  TO  2000:NEXT  X4 

CLS4 

MainLine:4 

GOSUB  HouseKeeping4 

GOSUB  ParameterEntry4 

GOSUB  DefineFieLds4 

IF  NoErrors  THEN4 

GOSUB  CreateZooFiLe4 
GOSUB  FiLeMaintenance4 

END  IF4 

GOSUB  EndJob4 

END4 
4 
HouseKeep  i  ng : 4 

DEFINT  a-z4 

WINDOW  l,"The  ZooKeeper" , (0,56) - (500, 186) , 154 

TRUE-  -14 

FALSE-  04 

HeaderBytes-  264 

CoLorMapBytes-  64  227 
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RETURN* 
4 
ParameterEntry:  4 

PRINT4 

INPUT  "Enter  name  of  AmigaBASIC  object  file:  ",FiL 
ename*4 

INPUT  "Enter  maximum  number  of  data  elements  per  s 
tatement:  " ,MaxBytes4 

PRINT4 

RETURN4 
4 
Def ineFieLds:4 

PRINT  "Input  file:   ";FiLename*4 

OPEN  FiLename*  FOR  INPUT  AS  14 
Image*=INPUT* (LOF ( 1 )  ,  1 )  4 

CLOSE  14 

Depth&«  CVL (MID* < Image*, 9, 4) ) 4 

WideSc"  CVL  (MID*  (Image*,  13,4)  )4 

HeightSc"  CVL  (MID* (Image*,  17,4)  ) 4 

Flags=  CVI (MID*( Image*, 21,2) )4 

BytesPerRow*  2* INT ( (Wide&+15) /16)4 

By tesPer PI ane=  BytesPer RowtHei ght&4 

BytesInBitmapa  BytesPerPlane*Depth&4 

IF  Flags  AND  1  THEN4 
ObjectIsSprite=  TRUE4 

ReqBytes=  Header Bytes+Bytes I nBi tmap+CoLorMapByte 
s4 

ELSE4 

Object IsSprite=  FALSE4 

ReqBytes*  HeaderBytes+BytesInBitmap4 

END  IF4 

IF  LEN( Image*) OReqBytes  THEN4 

PRINT  FiLename*;"  is  not  compatible  with  the  Zoo 
Keeper. "4 

NoErrors=  FALSE4 

ELSE4 

NoErrors=  TRUE4 

END  IF4 

RETURN4 

4 
CreateZooFiLe:4 

PRINT  "Output  file:  "; FiLename*; ". Z00"4 

PRINT4 

PRINT  "Please  wait... "4 

PRINT4 

OPEN  FiLename*+".ZOO"  FOR  OUTPUT  AS  14 

PRINT  #1,4 

PRINT  #  1,  "0bjectData:"4 

IF  Object I sSprite  THEN4 

PRINT  #1,  ■■'  SPRITE  Format "4 

ELSE4 
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PRINT 
END  IF4 
PRINT  # 
PRINT  # 
PRINT  # 
PRINT  # 


#  1 


1» 
i» 


BOB  Format "4 


" ; ReqBytes4 
" ; Depth&4 
";Wide&4 
";Height&4 


Total  Bytes: 

Bit  Planes: 

Pixels  Wide: 

Pixels  Tall: 

CurrentByte*  14 

Comment*-  "*  Object  Header "4 

CALL  Format Data (Comment*, MID* ( Image*, Cur rentByte, H 
eader Bytes) p  Max Bytes, 1 ) 4 

Cur rent Byte*  CurrentByte+HeaderBytes4 
FOR  PLane«l  TO  Depth«<4 

Comment*-  "*  Bit Plane  "+  STR*(PLane)4 
CALL  Format Data (Comment*, MID* < Image*, Cur rent Byte 
, BytesPer Plane) , Max Bytes, 1)4 

Curr entByte-  Cur r entByte+BytesPer PI ane4 
NEXT  PLane4 
IF  Object  I sSprite  THEN4 

Comment*""*  Sprite  Color  Map "4 

CALL  For mat Data (Comment*, MID* ( Image*, Cur rentByte 
, CoLorMapBytes) , Max Bytes, 1 ) 4 
END  IF4 
CLOSE  14 
RETURN4 
4 
Fi  LeMai  ntenance:  4 

PRINT  "Shall  I  delete  ";FiLename*; " 
INPUT  Response*4 
IF  UCASE* (Response*)' 
KILL  FiLename*4 
PRINT  FiLename*;"  deleted. "4 
END  IF4 
PRINT4 

RETURN  4 

4 
EndJob:4 

PRINT  "Job  complete: 
PRINT4 
RETURN4 
4 

SUB  FormatData(Note*,Dat*,DatLimit,FiLeNo)  STATIC4 
PRINT  #  FiLeNo,  Note*4 
NoBytes-  LEN(Dat*)4 

NoFuLLLi nes«  INT (NoBytes/DatLi mi t ) 4 
CurrentByte-  14 
FOR  LineOut=  1  TO  NoFuLLLi nes4 

CALL  PrintDataLine(MID*(Dat*,CurrentByte,DatLimi 
t) , FiLeNo) 4 

CurrentByte-  Cur r entByte+DatLi  mi  t4 
NEXT  Line0ut4 
IF  CurrentByteO  NoBytes  THEN4 


(y/n)";4 


"Y"  THEN4 


returning  to  AmigaBASIC- "4 
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By t esLef  t=  NoBy t es-Curren t By t e+ 1 4 
CALL  PrintDataLine(MID*(Dat*,CurrentByte,BytesLe 
ft),FiLeNo)4 

END  IF4 
END  SUB4 
4 
SUB  PrintDataLine(Dat*, FiLeNo)  STATIC4 

NoBytes-  LEN(Dat*)4 

PRINT  #  FiLeNo,  USING  "   DATA    ###" ; ASC (MID* (Dat* 
,1,1));4 

FOR  ELement-  2  TO  NoBytes4 

PRINT   #   FiLeNo,    USING    "_,    ###"; ASC (MID* (Dat*, ELe 
merit,  1)  )  ;4 

NEXT  ELement4 

PRINT  #  FiLeNo, 4 
END  SUB4 

Program  2.  Zookeeper  Demonstration 

Filename:  ZOOKEEPER.DEMO 

4 

'  Zookeeper  demonstration 

'  Copyright  1987  COMPUTE!  Publications,  Inc. 4 

'  All  rights  reserved^ 

PR I NT "Copyright  1987" : PR I NT "Compute !  Publications,  I 

nc."4 

PRINT"A11  Rights  Reserved. ": FOR  X-l  TO  2000:NEXT  X4 

CLS4 

MainLine:4 

GOSUB  HouseKeeping4 

GOSUB  InitPLayer4 

WHILE  INKEY*-""4 

IF  MOUSE (0)<>0  THEN4 
OBJECT. X  1,  MOUSE (1)4 
OBJECT. Y  1,  MOUSE (2) 4 
END  IF4 

WEND4 

END4 

4 
HouseKeep  i  ng  8  4 

DEFINT  a-z4 

WINDOW  l,"Ball  Demo", (0, 136) - (450, 186) , 154 

PRINT  "Manipulate  object  with  mouse. "4 

PRINT  "Hit  any  key  to  exit."4 

RETURN4 
4 
InitPLayer:4 

ByteCount-  1064 

Image*-  ""4 

FOR  Loop-  1  TO  ByteCount4 


230 


Programming 


READ  ImageData4 
Image**Image*+CHR* ( ImageData) 4 
NEXT  Loop4 

OBJECT. SHAPE  1,  Image** 
OBJECT. 0N4 
RETURN   4 
4 
4 
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Rick  Du  Chateau 


Add  new  capabilities  to  Amiga  Basic's  MENU  com- 
mand with  this  powerful  extension.  Requires  version 
1.2  of  Amiga  Basic. 

Amiga  Basic  may  be  the  most  powerful  BASIC  interpreter 
available.  However,  while  it  does  a  reasonable  job  of  provid- 
ing access  to  the  system  software  built  into  the  Amiga,  Amiga 
Basic  doesn't  support  the  system  software  as  completely  as 
compiled  languages  like  C,  Pascal,  and  Modula-2. 

As  an  example,  consider  Amiga  Basic's  MENU  command. 
With  it,  you  can  create  custom  menus  and  menu  items,  enable 
or  disable  the  items,  and  place  a  check  mark  next  to  a  menu 
item.  But  this  is  only  a  small  fraction  of  the  menu  features  and 
capabilities  provided  by  Intuition.  (Intuition  is  the  portion  of 
the  Amiga  operating  system  that  controls  the  user  interface — 
the  windows,  menus,  and  alert  boxes.)  Amiga  Basic's  MENU 
command  doesn't  provide  for  submenus,  command  keys,  al- 
ternate ways  of  highlighting  a  selected  menu,  and  the  ability 
to  turn  a  check  mark  on  or  off  while  excluding  the  other 
choices.  For  an  example  of  how  complex  and  useful  menus 
can  be,  load  Deluxe  Paint  II  and  wander  through  the  menus 
and  submenus. 

Fortunately,  the  designers  of  Amiga  Basic  provided  for 
these  and  future  features  by  making  Amiga  Basic  an  extensible 
language  through  the  use  of  subprograms  and  the  LIBRARY 
command.  By  using  LIBRARY,  the  Amiga  Basic  programmer 
has  access  to  the  multitude  of  the  Amiga's  operating  system 
routines.  And  subprograms  can  actually  add  new  commands 
to  Amiga  Basic. 

"SuperMenus"  illustrates  the  usefulness  of  subprograms 
by  adding  several  menu-related  commands  to  Amiga  Basic. 
These  new  commands  are  INITIALIZE,  SMENU,  SUBMENU, 
and  SMENUOFF.  Adding  SuperMenus  to  your  own  programs 
will  give  you  access  to  the  full  power  of  the  Amiga's  menu 
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system  and  will  enable  you  to  create  more  professional-looking 
programs.  A  short  demonstration  program  is  included  that  uti- 
lizes most  of  Supermenu's  features. 

Getting  Started 

Type  in  and  save  Program  1.  This  is  the  SuperMenus  routine. 
You  will  want  to  be  able  to  merge  this  routine  into  programs 
you  write  yourself,  so  you  must  save  the  program  in  ASCII 
(text)  format.  This  is  accomplished  by  adding  ,A  to  the  end  of 
the  SAVE  command: 

SAVE  "SuperMenus",A 

To  learn  how  to  use  the  routine,  type  in  and  save  a  copy 
of  Program  2,  SuperMenus. Demo.  Now  go  to  the  BASIC  com- 
mand window  and  type  LOAD  "SuperMenus. Demo";  then 
type  MERGE  "SuperMenus"  to  add  the  SuperMenus  routine 
to  the  demonstration  program.  Note  that  Program  2  will  not 
work  unless  you  merge  SuperMenus  with  it.  If  you  failed  to 
save  Program  1  as  an  ASCII  file,  youTl  see  the  error  message 
Bad  file  mode  when  you  give  the  MERGE  command. 

Run  the  resulting  program.  After  a  few  seconds,  you'll 
hear  a  beep  and  see  the  message  SuperMenus  Ready!  Use  the 
menu  select  button  (the  right  mouse  button)  to  view  the  vari- 
ous SuperMenu  features.  The  demonstration  will  print  any  se- 
lections you  make  (when  the  right  button  is  released).  Select 
Quit  to  exit  the  program. 

Follow  these  steps  to  incorporate  SuperMenus  into  your 
own  programs: 

•  After  loading  your  Amiga  Basic  program,  type  MERGE 
"SuperMenus". 

•  Add  the  following  lines  to  the  beginning  of  your  program: 

DECLARE  FUNCTION 

AllocMem&( )  LIBRARY 
INITIALIZE 

See  the  demonstration  program  for  an  example  of  how  this  is 
done. 
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•  Follow  the  format  described  below  to  create  a  menu. 

•  Call  the  SUBITEM  subprogram  to  test  for  a  subitem  selection 
(returned  in  variable  called  SubNum%). 

•  At  the  end  of  your  program  call  the  SMENUOFF 
subprogram. 

•  Save  your  program. 

•  Before  running  your  program,  be  sure  the  files  exec.bmap  and 
graphics.bmap  are  in  either  your  current  directory  or  the  Libs 
directory.  Follow  the  procedure  outlined  in  Appendix  B  for 
creating  these  files. 

The  Commands 

The  first  new  command,  INITIALIZE,  should  be  used  only 
once  before  the  SMENU  command.  This  subprogram  initial- 
izes all  of  the  variables  used  by  SuperMenus  and  loads  the 
necessary  libraries  from  disk. 

The  SMENU  command  is  the  heart  of  SuperMenus.  It's 
similar  to  Amiga  Basic's  MENU  command.  The  format  is 

SMENU  (Menu%,  Item%,  SubMenu°/o,  Flags%,  MExclude&, 
CommandKey$,  Text$,  SelecText$) 

The  items  in  italics  in  the  SMENU  command  have  the  follow- 
ing meanings: 

•  Menu°/o  is  the  menu  position,  in  the  range  1-10  (as  in  Amiga 
Basic  MENU). 

•  ItemVo  is  the  item  position,  in  the  range  1-19  (as  in  Amiga 
Basic  MENU). 

•  SubltemVo  is  the  subitem  position  (no  limit). 

•  Flags°/o  is  one  or  more  of  the  flags  listed  in  the  table  of  flags. 

•  MExclude&  is  used  in  conjunction  with  the  check%  and  tog- 
gle %  flags  in  the  table  of  flags.  Choosing  from  Iteml& 
through  Item31&  will  exclude  these  items  from  selection 
when  this  item  is  active.  For  example,  if  you  have  a  set  of 
menu  items  1,  2,  and  3,  and  if  you  set  MExclude&=  Item2& 
+  Item3&  for  the  first  menu  item,  then  when  item  1  is  se- 
lected (indicated  by  a  check  mark),  Intuition  will  erase  any 
check  marks  on  items  2  and  3.  See  the  Amiga  technical  man- 
uals for  additional  information. 
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•  CommandKey$  is  an  alphanumeric  character  to  be  used  with 
the  right  Amiga  key  to  select  this  item. 

•  Text$  is  the  text  to  be  used  for  this  item. 

•  SelecTextS  is  the  text  to  be  substituted  for  Text$  when  this 
item  is  selected  if  you  use  the  selectimage%  highlighting  flag. 

Amiga  Basic's  MENU(O)  and  MENU(l)  functions  return 
the  values  of  the  selected  menu  and  menu  item  respectively. 
So,  in  order  to  check  for  a  selected  subitem,  a  new  com- 
mand—SUBITEM— had  to  be  added.  SUBITEM  returns  a  se- 
lected subitem  number  in  the  variable  SubNum°/o. 

The  final  new  command,  SMENUOFF,  should  be  used  at 
the  end  of  your  program  to  free  up  the  memory  used  by 
Supermenus. 


Table  7-4.  Available  Flags 

You  may  select  as  many  of  these  flags  as  you  like: 

checkVo  Puts  a  check  mark  to  the  left  of  the  item  or 

subitem 

textVo  Indicates  that  the  item  or  subitem  consists  of 

text  as  opposed  to  a  graphic  image 

commandVo         Uses  this  flag  if  this  item  or  subitem  is  to  have 
a  command  key  associated  with  it 

toggle°/o  Uses  this  flag  in  conjunction  with  check°/o  to 

toggle  the  check  mark  on  or  off  with  selection 

enabled°/o  Indicates  the  item  or  subitem  is  enabled  as  op- 

posed to  ghosted  (off) 

You  must  select  one  and  only  one  of  the  following  high- 
lighting flags: 

compVo  Inverts  the  colors  of  an  item  or  subitem  during 

selection 
box°/o  Draws  a  box  around  the  item  or  subitem  during 

selection 
selectimageVo       Uses  a  defined  alternate  image  during  selection 
none°/o  Indicates  no  highlighting 
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Program  1.  Super  menus 

Filename:  SUPERMENUS 

For  instructions  on  entering  these  programs,  pJease  refer  to  Appendix  B, 
"COMPUTERS  Guide  to  Typing  In  Amiga  Programs." 

"  SuperMenus4 

'  Copyright  1987  COMPUTE!  Publications,  Inc.  4 

"  All  Rights  Reserved. 4 

4 

start:4 

4 

Initial:4 

4 

SUB  INITIALIZE   STATIC4 

DEFLNG  a-z4 

SHARED  checks,  text"/.,  command"/.,  toggLeX,  enabLed%4 

SHARED  image"/.,  comp/C,  box%,  noneX4 

SHARED  iteml, item2, item3,item4, itemS, item6,item7, i 
tem8, item9, item 104 

SHARED  itemll, iteml2, i teml3, i teml4, iteml5, iteml6, i 
teml7, i teml8, iteml9, item204 

SHARED  item21, item22, i tem23, i tem24, item25, item26, i 
tem27, i tem28, i tem29, i tem30, item314 
4 
LIBRARY  "exec.library"4 
LIBRARY  "graphics. library"4 


4 
4 


'Flag  Definitions4 
check"/.*  14 
text"/.-  24 
command  7-=  44 
toggLe"/.=  84 
enabLed7.«  164 
4 

seLectimage7.=  04 
compX*  644 
box  7.=  1284 
none"/.=  1924 


Mutual  Exclude  1 

iteml&» 

14 

item2&= 

24 

item3&= 

2  " 

24 

item4&= 

2  " 

34 

item5«c= 

2  * 

44 

item6&= 

2  ~ 

54 

item7&= 

2  " 

64 

item8&« 

2  " 

74 

item9&= 

2  * 

84 

iteml0&» 

=  2  *    94 

e  Flags* 


236 


Programming 


itemll&= 

2 

S\ 

104 

i  ternl2&a 

2 

•■*■• 

114 

i teml3&= 

2 

xs. 

124 

iteml4&= 

2 

•\ 

134 

iteml5&= 

2 

•\ 

144 

i teml6&= 

2 

XK 

154 

i teml7&= 

2 

•\ 

164 

iteml8&= 

2 

XK 

174 

iteml98c= 

2 

XV 

184 

i  tem20&= 

2 

•\ 

194 

item21&= 

2 

•\ 

204 

item228c= 

2 

x\ 

214 

i  tem23&= 

2 

x\ 

224 

i  tem248c= 

2 

•\ 

234 

item25&= 

2 

•\ 

244 

i  tem26&= 

2 

x\ 

254 

i  tem278c= 

2 

•\ 

264 

i  tem28&= 

2 

•\ 

274 

item298c= 

2 

y\ 

284 

i  tem30&= 

2 

•\ 

294 

item31&= 

2 

•\ 

304 

4 

END  SUB   4 

4 

SMenus:  4 

4 

SUB  SMENU<xpos> 

C,  ypos"/.,  spos'/.,  f LagsX, mexcLude&,  Key*,  t  i 

tLe*,titLe2*)  STATIC4 

4 

SHARED  Address&4 

4 

DEFLNB  a-z  4 

IF  spos7.=0  THEN4 

4 

IF  <fLags7.  AND  16)  THEN  active7.=  1  ELSE  active'/.=  0 
4 

MENU  xpos7.,ypos7.,active7.,titLe*      4 

staLL=TIMER:WHILE  TIMER  <  (staLL  +  1 ) : WEND   'Bive 
AmigaBasic  time  to  SetMenuStrip4 
4 

GOTO  SetKey4 

END  IF4 
4 
SetSPoss4 

4 

Address*  PEEKL (WINDOW (7)  +  28)4 

IF  xpos7.  >1  THEN  CALL  FindAddress  <xpos7.)  4 

MenuAdd=  Address4 

4 

Tex tAttr=ALLocMem ( 12&, 65S39&) 4 
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CALL  AskFont (WINDOW (8) ,TextAttr)4 

height7.=PEEKW(TextAttr  +  4)   'Find  the  height  o-f  c 
urrent  -font -4 

4 

titLe*-  titLe*  +  CHR*<0)4 

wide7.-  LENCtitLe*)  *  104 

titLe-  SADD<titLe*)4 
4 

Intuit-  ALLocMem(20,65539&)4 

IF  Intuit-  0  THEN  PRINT  "No  Memory !!": ST0P4 

4 

POKE  Intuit  +  1,  1   'Set  BackPen  to  color  regis 
ter  14 

4 

POKE  Intuit  +  2,  1   'Set  DrawMode4 

POKEL  Intuit  +  12,  titLe4 

4 

sub  item*  ALLocMem<34,  65539S<)4 

IF  subitem-  0  THEN  PRINT  "No  Memory !!": 5T0P4 

4 

POKEW  subitem  +  4,50   'Start  the  subitem  50  pix 
els  to  the  right  of  the  Menu4 

POKEW  subitem  +  6, height"/.  *  spos7-   'Figure  the 
top  position4 

POKEW  subitem  +  8,wide7.4 

POKEW  subitem  +  10,height7.4 

POKEW  subitem  +  12,824 

POKEL  subitem  +  18,Intuit4 

Address-  PEEKL (MenuAdd  +  18)4 

IF  ypos"/.  >1  THEN  CALL  Fi  ndAddress  (ypos7.)  4 

ItemAdd=  Address4 

IF  spos7.  =  1  THEN  Address-  ItemAdd  +    28:  GOTO  Ski 
plt4 

4 

Address-  PEEKL ( ItemAdd  +  28)       4 
4 

IF  spos7.  >  2  THEN4 

CALL  Fi  ndAddress  <spos7.  -1)4 

END  IF4 
4 
Skiplt:4 

4 

POKEL  Address, subitem4 
4 

CALL  FreeMem(TextAttr, 12)  4 

4 
Set Key: 4 
4 

Address-  PEEKL (WINDOW (7)  +  28)    4 
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IF  xpos7.  >  1  THEN  CALL  FindAddress  (xpos7.)  4 

4 
Address=  PEEKL (Address  +  18)4 
IF  ypos7.  >  1  THEN  CALL  FindAddress  <ypos7.)  4 
4 

IF  spos7.  >  0  THEN4 
Address=  PEEKL (Address  +  28)4 
IF  spos7.=  1  THEN  PokeKey4 
4 
CALL  FindAddress  (spos7.)  4 
END  IF4 
4 

PokeKey:4 
4 

POKEW  Address  +  12,fLags7.   'Set  the  Flags4 
POKEL  Address  +  14, mexcLude&4 

IF  Key*  <>  " "  THEN  POKE  Address  +  26,ASC(Key*) 
'Poke  in  the  Key4 
4 

IF  titLe2*  <>  ,,M  THEN4 
4 

titLe2*=  titLe2*  +  CHR*(0)4 
wide7.=  LEN(titLe2*)  *  104 
titLe=  SADD(titLe2*)4 

4 
Intuit=  ALLocMem(20,65539&)4 

IF  Intuit=  0  THEN  PRINT  "No  Memory !!": ST0P4 
4 

POKE  Intuit  +  1,  1   'Set  BackPen  to  color  regis 
ter  14 
4 

POKE  Intuit  +  2,  1   'Set  DrawModex 
POKEL  Intuit  +  12,  titLe4 
POKEL  Address  +  22,  Intuit4 
4 

END  IF4 
4 

0utaHere:4 
END  SUB4 
4 

SUB  FindAddress  (Position7.)  STATIC4 
SHARED  Address4 
4 

FOR  counter'/.^  1  TO  (Position7.  -1)4 
Address=  PEEKL (Address) 4 
NEXT  4 

END  SUB  4 

4 
TurnSmenuOf f : 4 
4 
SUB  SMENUOFF  STATIC4 
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4 

MenuAdd=  PEEKL (WINDOW (7)  +  28)4 
4 
Again: 4 

IF  MenuAdd=  0  THEN  ALLDone4 
GOSUB  ItemAddress4 
4 

MenuAddress: 4 
MenuAdd=  PEEKL (MenuAdd) 4 
GOTO  Again4 
4 
ItemAddress: 4 

IF  PEEKL (MenuAdd  +  18)  »  0  THEN  OutOf Items    4 
4 

ItemAdd=  PEEKL (MenuAdd  +  18)4 

IF  PEEKL (ItemAdd  +  22)  >  0  AND  PEEKL ( ItemAdd  + 
22)  <>  PEEKL (ItemAdd  +  22)  THEN  4 

Intuit=  PEEKL (ItemAdd  +  22)4 

CALL  FreeMem( Intuit, 20)  Tree  Select 

IntuiText4 

END  IF4 
4 

KeepLooking:  4 
4 

GOSUB  LookForSub4 
ItemAdd=  PEEKL ( ItemAdd) 4 
IF  ItemAdd  >  0  THEN  KeepLooking4 
OutOf Items: 4 
RETURN4 
4 
LookForSub:4 

IF  PEEKL  (ItemAdd  +  28)  =0  THEN  0ut0-fSubs4 
Address*  PEEKL ( ItemAdd  +  28)4 
4 

CLearMem:4 

NextAddress*  PEEKL (Address) 4 
Intuit*  PEEKL (Address  +  18)4 
CALL  FreeMem( Intuit, 20)   'Free  Intuitext4 
4 

IF  PEEKL (Address  +22)  >  0  AND  PEEKL (Address  +  2 
2)  <>  PEEKL (Address  +  18)  THEN  4 

Intuitu  PEEKL (Address  +  22)4 

CALL  FreeMem( Intuit, 20)  'Free  Select  In 

tuiText4 

END  IF4 
4 

CALL  FreeMem (Address, 34)        'Free  Item  Stru 
cture    4 
4 

Address*  NextAddress4 
IF  Address  >  0  THEN  CLearMem4 
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4 
0ut0fSubs:4 
RETURN4 

4 
ALLDone:4 
4 

LIBRARY  CL0SE4 

MENU  RESET4 

END  SUB4 
4 
CheckSmenus: 4 

4 
SUB  SUBMENU  STATIC4 
DEFLNG  a-z4 
SHARED  SubNum7.4 

intuitmessage=  PEEKL (WINDOW (7)  +  94)4 
menucode-  intuit message  +  244 

SubNumX-  (PEEKW(menucode)/  (2^11)  AND  31)  +  14 
IF  SubNum7.=  32  THEN  SubNum7.=  0   'No  Sub  i-f  all  bits 
"on  "4 
4 

END  SUB4 
4 

Program  2.  Supermenus  Demo 

Filename:  SUPERMENUS.DEMO 

4 

*  SuperMenu  Demo4 

'Copyright  1987  COMPUTE!  Publications,  Inc. 4 

'All  Rights  Reserved. 4 

4 

DECLARE  FUNCTION  ALLocMem&O  LIBRARY4 

4 

ON  ERROR  GOTO  HandLeErrors4 

4 

INITIALIZE4 

PRINT  "Copyright  1987": PRINT"COMPUTE !  Publications, 

Inc."4 

PRINT  "All  Rights  Reserved. "4 

PRINT4 

PRINT  "Setting  up  SuperMenus,  wait  for  the  BEEP. "4 

4 

MExcLude&=0     4 

FLags7.=  text7.  +  enabLed7.  +  comp%4 

SMENU  l,0,0,FLags7.,MExcLude&,  "",  "First",  ""4 

SMENU  2,  0,0,  FLags7.,  MExcLudefc,  "  "  ,  "Second "  ,  "  "4 

SMENU  3, 0,0,0,MExcLude&, "","",""    'Blank  out  menus 

3  and  44 

SMENU  4,0,0, 0, MExcLudefc, " " , " " , " "4 

FLags%=  text%   +  enabLedfc  +  comp%4 
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SMENU  1,1, 0,  FLags"/., MExcLudefc, " " , " ItemA" , " "4 

SMENU  1,2,0,  FLags"/.,  MExcLudefc,  "  "  ,  "  ItemB"  ,  "  "4 

FLags%=  text%  +  enabLed^  +  box%  +  command7.4 

SMENU  1,3,0, FLags"/., MExcLudefc, "Q" , "Qui  t     " , " "4 

4 

MExcLude&=  item2&4 

FLags7.=  text"/.  +  enabLed"/.   +  toggLe"/.   +  check"/.  +  seLe 

ctimage%4 

SMENU  1,  1,  1,  FLags"/.,  MExcLudefc,  MM,  "    Sub  1 1  em  1     "," 

ALternate"4 
MExcLude&=  iteml&4 
FLags%=  text%  +  enabLed^  +  comp'/.   +  toggLeX   +  check 

SMENU  1,  1,2,  FLags"/.,  MExcLudefc,  "",  "    Subltem2" , " "4 

MExcLude&=  04 

FLags%=  text"/  +  enabLed7.  +  toggLeX  +  check"/  +  comp'/. 

+  command  7-4 

SMENU  2,  1, 0,  FLags"/.,  MExcLude&,"T",  "    Menu2Iteml 

,,,H4 

MExcLude&=  04 

FLags7.=  text"/.  +  enabLed"/  +  comp"/.4 

SMENU  2,2,0,FLags7.,MExcLude&,  "  " ,  "    Menu2Item2     ", 
it  M  • 

MExcLudeS<~  item2&4 

FLags%=  text/C  +  enabLed"/  +  toggLe"/  +  check'/.  +  comman 

d"/  +  comp"/.4 

SMENU  2,2,  1,  FLags"/,  MExcLudefc,  "A",  "    Item2Subl    "," 

"4 

MExcLude&=  iteml&4 

FLags7.=  text"/.  +  enabLed"/.  +  toggLe"/  +  check"/.  +  box"/.4 

SMENU  2,2,2,FLags"/,MExcLude&,  "",  "    Item2Sub2    "  ,  "  " 

4 

MExcLude&=  iteml&  +  item2&4 

FLags7.=  text"/.  4 

SMENU  2,2,3,FLags"/,MExcLude&,  "  M  ,  "    Disabled",  ""4 

4 

BEEP4 

4 

PRINT4 

PRINT  "SuperMenus  Ready ! "4 

4 

CheckMenus: 4 

4 

MenuNum7.=  MENU  (0)4 
4 

IF  MenuNum"/=  0  THEN  CheckMenus4 
4 
ItemNum7.=  MENU(1)4 
SUBMENU4 

PRINT  "MenuNum=  ■•  ;  MenuNum"/.,  "  ItemNum=  "  ;  ItemNum"/.,  " 
SubNum=  ";SubNum7.4 
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4 
IF  MenuNum%=  1  AND  ItemNum"/.  =  3  THEN  CALL  SMENUOFF:E 
ND4 
4 

GOTO  CheckMenus4 
4 

HandLeErrors: 4 
4 

IF  ERR=  53  THEN4 

PRINT  "You  must  have  the  files  ' exec. bmap' 
and  'graphics. bmap' "4 

PRINT  "in  either  your  current  or  Libs  dire 
ctory. "4 


END  IF4 
END4 
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Jim  Butterfield 


Learn  about  the  powerful  technique  of  using  ramdisk 

files  on  the  Amiga.  The  use  of  a  ramdisk  speeds  up 

disk  access  tremendously,  since  ramdisk  operations 

occur  in  the  RAM  (Random  Access  Memory]  of  the 

computer.  A  sample  program  is  included. 

When  most  people  think  of  data  files,  they  think  of  collections 
of  information  stored  on  magnetic  media — disk  or  tape.  But 
files  may  also  be  stored,  at  least  temporarily,  in  the  computer's 
RAM  (Random  Access  Memory).  Special  software  can  allow 
the  computer  to  simulate  the  actions  of  a  physical  disk  drive 
using  a  portion  of  memory  for  storage.  Because  the  memory 
storage  behaves  just  like  a  physical  disk,  it's  frequently  re- 
ferred to  as  a  ramdisk.  This  article  explains  simple  sequential 
ramdisk  file  techniques  for  the  Amiga.  The  Amiga's  operating 
system  has  built-in  support  for  ramdisks. 

Temporary  Files 

Many  programs  create  temporary  files.  Such  a  file  often  con- 
tains partially  processed  data;  the  program  has  worked 
through  the  data  concerned,  but  cannot  finish  the  job  until  it 
has  completed  another  pass  through  the  data. 

As  an  example,  consider  a  program  which  collects  a  series 
of  examination  scores  for  a  class  of  students.  Among  other 
things,  its  job  is  to  print  each  student's  performance  compared 
with  the  class  average.  The  program  can't  print  the  compari- 
son at  the  time  it  receives  each  student's  score  since  it  can't 
know  the  average  score  until  all  the  grades  have  been  entered. 
One  solution  is  to  use  a  temporary  file  to  store  the  scores  as 
they  come  in. 

Another  classic  data  processing  task  that  benefits  from 
temporary  files  is  assembling  a  machine  language  program. 
The  assembler  program  can  do  part  of  its  work  as  it  reads  the 
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source  code,  but  it  can't  finish  the  job  until  all  the  source  code 
has  been  read.  The  assembler  can  create  a  partially  processed 
temporary  file.  Then,  on  the  next  pass  through  the  data,  it  can 
read  back  this  file  and  fill  in  any  missing  information. 

In  cases  like  these,  the  use  of  a  ramdisk  can  dramatically 
improve  program  performance.  Files  held  in  a  ramdisk  can  be 
retrieved  much  more  quickly  than  files  on  a  disk  in  a  mechan- 
ical drive — even  a  high-speed  hard  disk  drive.  For  a  ramdisk, 
the  computer  need  only  read  data  from  memory — something 
it  can  do  with  blinding  speed.  Reading  data  from  disk,  on  the 
other  hand,  involves  a  number  of  mechanical  tasks  in  addition 
to  the  electronic  communications.  Before  the  first  byte  can  be 
read,  the  drive  must  start  the  disk  spinning,  determine  the  po- 
sition of  the  file  on  the  disk  surface,  move  the  read/write 
head  to  the  proper  track,  and  wait  for  the  first  sector  of  the  file 
to  spin  by. 

Since  the  ramdisk  is  so  much  faster,  you  may  wonder 
why  it  isn't  used  exclusively  for  program  storage.  The  answer 
is  that  ramdisks  have  one  very  significant  shortcoming:  Since 
all  the  information  is  stored  in  memory,  everything  in  a 
ramdisk  is  lost  whenever  the  computer  is  turned  off,  even  if 
the  power  interruption  is  accidental  or  only  momentary.  For 
this  reason,  ramdisks  are  generally  used  only  for  temporary 
files  containing  information  that  needs  to  be  retrieved  quickly, 
but  could  be  reconstructed  easily,  if  lost.  Physical  drives  are 
still  the  best  choice  for  permanent  file  storage. 

"Ramdisker,"  the  program  at  the  end  of  this  article,  illus- 
trates the  use  of  ramdisk  files  in  a  routine  to  calculate  prime 
numbers.  Type  in  the  program  and  save  it  to  disk. 

Prime  Numbers 

One  definition  of  a  prime  number  is  one  which  is  not  evenly 
divisible  by  any  lower  prime  number,  assuming  that  the  first 
prime  number  is  2.  This  kind  of  definition  is  known  as  recur- 
sive. The  series  of  prime  numbers  begins  like  this:  2,  3,  5,  7, 
11,  13,  17,  and  so  on.  A  more  technical  definition  of  a  prime 
number  is  a  number  that  is  divisible  only  by  1  and  itself.  The 
number  1  is  included  in  the  prime  series  when  we  use  this 
definition. 
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The  example  program  uses  the  recursive  definition  to  gen- 
erate prime  numbers.  We  begin  with  2.  For  all  following  inte- 
gers, the  program  tries  dividing  into  the  current  value  all 
previous  primes  it  has  found.  If  none  of  them  divide  evenly, 
the  new  value  is  added  to  the  list  of  primes.  To  speed  up  the 
routine,  the  range  of  trial  divisors  is  restricted  to  those  less 
than  or  equal  to  the  square  root  of  the  number  being  tested. 

As  each  prime  number  is  found,  it  is  placed  in  a  tempo- 
rary file  called  PRIMES.  For  the  first  prime,  2,  the  file  must  be 
opened  for  writing.  Subsequent  numbers  are  tacked  onto  the 
end  of  the  file  by  opening  it  for  appending. 

The  performance  of  the  routine  is  further  enhanced  by 
examining  only  odd  numbers.  All  even  numbers  other  than  2 
are  divisible  by  2  and,  hence,  cannot  be  prime. 

Getting  Started 

The  Amiga  includes  built-in  support  for  ramdisks;  however,  to 
conserve  memory,  the  operating  system  does  not  normally  set 
up  a  ramdisk  when  the  system  is  booted.  Instead,  it  waits  until 
you  first  request  access  to  the  ramdisk  and  then  allocates  the 
memory  at  that  time.  In  Amiga  Basic,  you  can  establish  a 
ramdisk  file  simply  by  referencing  the  device  name  ram:. 

Saving  Your  Work 

If  you've  loaded  the  Workbench,  youTl  find  a  ramdisk  icon  on 
it's  screen  when  you  return  there  after  running  Ramdisker. 
Double-click  on  the  ramdisk  icon,  and  youTl  see  an  icon  for  a 
file  named  primes.  This  is  the  temporary  file  containing  the 
prime  number  values.  If  you  wish  to  keep  this  file,  you  must 
copy  the  program  to  a  physical  disk.  Drag  the  primes  icon 
onto  the  icon  of  the  disk  or  drawer  where  you  want  it  to  go. 
If  you're  using  the  Amiga's  CLI  (Command  Line  Inter- 
preter) instead  of  the  Workbench,  typing  INFO  will  show  you 
there's  a  ramdisk  mounted.  Use  DIR  RAM:  or  LIST  RAM:  to 
see  its  contents.  To  move  the  primes  file  to  a  more  permanent 
place,  use  the  COPY  command.  If  you  want  the  data  file's 
icon  to  be  visible  on  the  Workbench,  you  must  also  copy  the 
associated  primes. info  file. 
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Without  RAM 

Ramdisker  also  works  with  a  regular  disk  drive.  For  the  sake  of 
comparison,  you  might  want  to  run  the  program  in  this  man- 
ner. In  Ramdisker,  change  the  device  name  in  the  OPEN  state- 
ment from  ram:  to  dfO:.  You'll  see  the  brakes  go  on  as  your 
program  slows  to  the  speed  of  the  mechanical  disk  unit. 

That's  why  using  a  ramdisk  is  so  easy.  No  new  or  special 
programming  techniques  are  required — and  it  sure  speeds 
things  up. 

Ramdisker 

Filename:  RAMDISKER 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

'  Copyright  1987  COMPUTE!  Publications,  Inc.* 
9    All  Rights  Reserved. 4 

*  PRIMES  PROGRAM* 

*  DEMONSTRATES  FILES  TO  RAM:* 

PRINT  "Copyright  1987": PRINT  "COMPUTE!  Publications, 

Inc."* 
PRINT  "All  Rights  Reserved.": FOR  t=l  TO  10000:NEXT* 
CLS* 
p«2* 

INPUT  "Primes  to  what  value";v* 
OPEN  "ram: primes"  FOR  OUTPUT  AS  1* 
GOSUB  putprime* 
CLOSE  #1* 
WHILE  p=3* 

p=p+2* 

i 1 ag=0* 

d=0* 

q=SQR(p>* 

OPEN  "ram: primes"  FOR  INPUT  AS  1* 

WHILE  NOT  E0F<1>  AND  d<q  AND  NOT  flag* 
INPUT  #l,d* 
flag=<p  MOD  d  =  0)* 

WEND* 

CLOSE  #1* 

IF  NOT  -flag  THEN* 

OPEN  "ram: primes"  FOR  APPEND  AS  1* 

GOSUB  putprime* 

CLOSE  #1* 
END  IF* 
WEND  * 
END* 
putprime: * 


247 


CHAPTER  SEVEN 


PRINT  #l,p4 

LIN=LIN+14 

PRINT  USING  "  #####" ;p; 4 

IF  LIN>9  THEN  LIN=0:PRINT4 
RETURN4 
4 
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Here's  a  versatile  input  routine  for  use  in  your  Amiga 
Basic  programs.  Written  as  a  subprogram,  this  input 
routine  selectively  masks  out  all  unwanted  charac- 
ters. Whether  you  need  numeric  input  or  a  simple 
Y/N  response,  "Masked  Input"  can  do  the  job. 

Probably  the  most  vulnerable  part  of  a  program  is  its  input 
routine.  If  a  program  is  going  to  crash,  it  usually  does  so  here. 
To  avoid  such  occurrences,  input  routines  must  carefully 
screen  illegal  and  unacceptable  keypresses.  For  example,  when 
the  program  is  expecting  a  numeric  response,  the  input  routine 
should  accept  only  numeric  data.  Editing  keys  must  be  moni- 
tored as  well.  You  don't  want  someone  who  is  using  the  pro- 
gram to  accidentally  clear  the  screen  or  backspace  over  your 
input  prompt  simply  because  the  wrong  key  is  pressed. 

"Masked  Input"  is  an  Amiga  Basic  subprogram  that  pro- 
vides a  welcome  alternative  to  the  INPUT  statement.  Because 
it  is  a  subprogram,  Masked  Input  easily  can  be  included  in 
your  own  programs.  Besides  being  useful,  Masked  Input  offers 
a  good  example  of  the  use  of  subprograms  and  Amiga  library 
routines. 

Getting  Started 

Type  in  the  demo  program  and  save  a  copy  before  you  run  it. 
This  program  contains  both  the  Masked  Input  subprogram, 
named  INPUTSTRING,  and  some  preliminary  code  that  dem- 
onstrates its  use. 

Masked  Input  makes  use  of  the  Amiga  library  file 
graphics.bmap.  This  file  is  included  in  the  BasicDemos  drawer 
of  the  Amiga  Extras  version  1.1  (if  you  use  version  1.2  see  Ap- 
pendix B).  Before  you  run  the  program,  make  sure  that  a  copy 
of  the  graphics.bmap  file  is  on  the  same  disk  as  the  demo  pro- 
gram. The  location  of  this  file  is  important.  It  must  be  either  in 
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the  current  directory  or  in  the  directory  named  LIBS  on  the 
disk  used  when  you  booted  the  system.  If  you  do  not  have 
this  library  file  in  the  correct  place,  BASIC  will  stop  with  a  file 
not  found  error  when  you  run  the  program. 

When  run  the  demo  program  asks  you  to  enter  a  string 
length  and  edit  mask  (see  below  for  details).  Next,  the  pro- 
gram calls  the  INPUTSTRING  subprogram  using  your  previ- 
ous two  entries,  prompting  you  for  your  final  input.  After  you 
press  RETURN,  the  computer  echoes  your  entry  to  the  screen, 
waits  for  the  RETURN  key  to  be  pressed,  and  then  reruns  the 
program. 

Using  the  Subprogram 

The  proper  syntax  for  calling  INPUTSTRING  is 
CALL  INFUTSTRING(entry$,strlen,emask) 

Amiga  Basic  also  provides  an  alternative  CALL  syntax  that  al- 
lows the  subprogram  to  be  used  like  a  new  BASIC  command: 

INPUTSTRING  entry  $  .strlen,  emask 

INPUTSTRING  requires  three  parameters:  entry$,  strlen,  and 
emask.  The  string  variable  entry$  returns  the  text  entered  by 
the  user.  The  strlen  parameter  specifies  the  maximum  length 
of  input  to  be  allowed.  The  emask  parameter  is  an  edit  mask 
that  determines  the  type  of  data  that  can  be  entered.  Valid 
values  for  emask  range  from  0  to  127.  Different  mask  values 
produce  the  results  shown  in  Table  7-5. 

Table  7-5.  Mask  Value  Results 

Value  Function 

0  All  characters  accepted 

1  Numbers  0-9 

2  Punctuation  marks  .,  +,  and  — 

4  Upper-  and  lowercase  letters  A-Z 

8  Blanks  (spaces)  allowed 

16  Uppercase  letters  A-Z 

32  Characters  Y  and  N 

64  Null  input  not  allowed 
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An  important  aspect  of  this  method  of  masking  is  that  the 
emask  values  may  be  added  together  to  produce  a  cumulative 
effect.  A  value  of  85  (1  +  4  +  16  +  64),  for  example,  allows 
numbers,  upper-  and  lowercase  letters,  and  spaces,  but  not 
punctuation  characters  or  a  null  input.  This  method  of  input 
masking  puts  the  programmer  in  complete  control. 

INPUTSTRING  uses  less-than  and  greater-than  symbols 
(<  and  >,  respectively)  to  frame  the  area  of  input.  This  lets 
the  user  see  exactly  how  many  characters  can  be  entered.  All 
responses  are  returned  in  the  variable  entry$.  If  a  numeric 
value  is  required,  entry  $  may  be  converted  to  a  number  with 
the  VAL  function  as  illustrated  in  the  demo  program. 

This  subprogram  is  fully  documented  with  remark  state- 
ments. All  comments  that  follow  the  apostrophes  found  at  the 
end  of  lines  are  instructional  and  may  be  omitted.  The  com- 
ments following  the  remarks,  however,  should  be  left  in  place 
to  document  the  different  parameters  that  are  necessary  for 
using  the  subprogram. 

Editing  Keys 

In  addition  to  the  keys  allowed  by  the  edit  mask,  several  other 
keys  are  available  for  editing  input.  The  RETURN  key  termi- 
nates input.  The  cursor  keys  allow  you  to  move  through  en- 
tered text.  The  current  position  of  the  cursor  is  denoted  by  an 
underline  character.  The  BACK  SPACE  key  deletes  characters 
at  the  end  of  the  input  string.  Pressing  the  DEL  key  erases  the 
entire  input  field. 

Subprograms 

As  explained  above,  the  entire  input  routine  is  contained  in 
the  subprogram  named  INPUTSTRING.  A  subprogram  is  a 
section  of  code  that  is  called  by  the  main  program  and  inter- 
acts with  the  main  program  by  passing  data  back  and  forth 
through  variables  called  parameters.  Parameters  are  listed  in 
parentheses  after  the  subprogram  name.  Other  variables  may 
also  be  held  in  common  between  the  main  program  and  the 
subprogram  through  the  use  of  the  SHARED  statement.  Ex- 
cept for  passed  parameters  and  shared  variables,  the  subpro- 
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gram  acts  as  though  it  were  in  a  world  by  itself.  All  other 
variables  used  within  the  subprogram  are  referred  to  as  local 
variables,  which  means  they  are  known  only  to  the  subpro- 
gram. Thus,  the  variable  LOOP.CNTR  in  the  main  program 
and  the  variable  LOOP.CNTR  in  a  subprogram  are  treated  as 
two  different  variables  and  do  not  interfere  with  each  other. 

Why  use  a  subprogram  instead  of  a  subroutine  to  perform 
this  input  function?  The  main  reason  is  efficiency.  Once  a  sub- 
program has  been  written,  debugged,  and  polished  up,  it  can 
be  attached  to  any  program  that  requires  its  services.  With  a 
variety  of  prewritten  subprograms,  you  no  longer  have  to  re- 
write vital  routines  for  each  new  program.  Ideally,  one  could 
build  and  maintain  a  whole  library  of  subprograms,  each  one 
designed  for  a  specific  application  (inputting,  sorting,  reading  a 
disk  directory,  and  so  on).  Writing  a  program  would  then  sim- 
ply consist  of  splicing  the  appropriate  subprogram  into  the 
main  program.  And  because  each  subprogram  acts  indepen- 
dently, you  do  not  have  to  worry  about  conflicting  variable 
names. 

It's  easy  to  create  a  version  of  the  Masked  Input  subpro- 
gram that  you  can  add  to  your  own  programs.  First,  load  the 
demonstration  program  and  delete  all  the  lines  that  come 
before  the  SUB  INPUTSTRING  statement.  Next,  save  the  sub- 
program text  to  disk  as  an  ASCII  file.  Use  a  statement  of  the 
form 

SAVE  "masked  input",A 

When  you  want  to  add  the  subprogram  to  one  of  your 
own  programs,  load  or  type  in  that  program  and  then  use  a 
command  of  the  form 

MERGE  "masked  input" 

to  add  the  subprogram  text  from  disk.  Then  add  the  state- 
ments for  access  to  the  graphics  library  routines,  as  explained 
below.  All  that's  left  is  to  add  CALL  statements  for  the 
INPUTSTRING  subprogram  and  your  program  is  set  up  for 
customized  input. 
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Libraries 

When  the  Amiga  is  first  booted  with  Kickstart,  approximately 
192K  of  operating  system  is  loaded  into  the  upper  part  of  the 
computer's  memory.  (Kickstart  is  found  in  ROM  on  the  Amiga 
500  and  Amiga  2000.)  This  code  contains,  among  many  other 
things,  a  whole  set  of  instructions  that  manage  the  Amiga's 
graphics.  This  set  of  instructions  is  organized  into  a  neat  col- 
lection of  routines  collectively  known  as  the  graphics  library, 
which  consists  of  such  routines  as  ClearScreen( ),  Draw( ), 
WritePixel( ),  and  SetSoftStyle( ). 

Before  any  library  routine  can  be  used  from  BASIC,  you 
must  open  the  library  with  the  LIBRARY  command.  In  the 
case  of  our  Masked  Input  routine,  the  command  LIBRARY 
"graphics.library"  is  used.  Executing  this  command  instructs 
Amiga  Basic  to  load  the  file  graphics. bmap.  (See  Appendix  B 
for  instructions  on  creating  .bmap  files.) 

To  create  an  underlined  cursor,  INPUTSTRING  uses  the 
graphics  library  routine  named  SetSoftStyle( ).  This  routine  al- 
lows you  to  change  a  font's  type  style.  The  syntax  for 
SetSoftStyle  is 

CALL  SetSoftStyle&(WINDOW(8),/onf. sty lejont. mask) 

where  WINDOW(8)  is  a  pointer  to  the  RastPort  for  the  current 
window,  font. style  is  a  value  in  the  range  0-7,  and  font. mask  is 
a  value  that  specifies  which  type  styles  are  valid  for  a  particu- 
lar font.  Not  all  fonts  have  the  capability  of  producing  every 
type  style. 

To  ensure  that  Amiga  Basic  interprets  this  as  a  function 
and  not  as  an  array  reference,  a  DECLARE  FUNCTION 
AskSoftStyle&  LIBRARY  command  is  placed  near  the  begin- 
ning of  the  demo  program.  At  this  point,  we're  ready  to 
change  a  character's  font  style  to  produce  an  underlined 
cursor.  Legal  values  for  the  font.style  parameter  are  shown  in 
Table  7-6. 


Table  7-6.  Legal  font.style  Parameters 


due 

Font 

0 

normal 

1 

underlined 

2 

boldface 

4 

italics 
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These  values  may  be  added  together  to  achieve  multiple 
font  styles.  For  example,  a  value  of  3  produces  underlined 
boldface  type.  For  our  purposes,  however,  we  need  only  use  a 
1  for  underline. 

Masked  Input  Demonstration 

Filename:  MASKED.INPUT 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTEl's  Guide  to  Typing  In  Amiga  Programs." 

*  Copyright  1987  COMPUTE!  Publications,  Inc.* 

'  All  Rights  Reserved 4 

4 

demo. driver: 4 

'  the  following  declaration  must  be  made  in  the  ca 
lling  program4 

DECLARE  FUNCTION  AskSof tStyle*  LIBRARY4 
4 

LIBRARY  "graphics. library"      '  tell  AmigaBASIC  t 
o  reAd    it4 
4 
start:  4 

CLS4 

PR I NT "Copyright  1987  COMPUTE!  Publications,  Inc. "4 

PRINT"  All  Rights  Reserved. ": FOR  tt=l  TO  3 

500: NEXT  tt4 

CLS  4 

strLen  =  2:  emask  «  1  *  set 

default  values4 

LOCATE  2,2:  PRINT  "Enter  string  length  ";     •  set 
up  prompt  4 

CALL  INPUTSTRINS  (entry*, strLen, emask)        *  get 
input4 

size  «■  VAL (entry*):  strLen  =  3  *  con 

vert  to  #  8c  reset  length4 

LOCATE  4,2:  PRINT  "Enter  edit  mask  (0  -  127)  ";4 

CALL  INPUTSTRING  (entry*, strLen, emask)         4 

mask  -  VAL (entry*)  *  con 

vert  to  number4 

CLS:  PRINT:  PRINT  "Enter  input  here  =>  ";4 

CALL  INPUTSTRING  (entry*, size, mask) 4 

PRINT:  PRINT:  PRINT  "User  input  was    «>   "; entry* 
4 

LOCATE  20,10:  PRINT  "PRESS  ANY  KEY "4 
get . Loop : 4 

g*  -  INKEY*:  IF  g*  -  ""  THEN  get.Loop4 

GOTO  start: 4 
4 
SUB  INPUTSTRING  (entry*, strLen, emask)  STATIC: 4 

REM  entry*  =  input  string  returned  to  calling  prog 
ram4 
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REM  strlen  =  maximum  size  of  field  to  be  input  4 

REM  emask   =  number  (0-127)  that  determines  input 
field  traits* 

REM  emask   «■  see  table  at  end  of  subprogram  for  va 
lues  &  traits* 
4 

pos*.styLe7.  -   AskSof tStyle* (WINDOW (8) )     *    get  p 
ossible  styles  4 

IF  emask  <  0  OR  emask  >  127  THEN  emask  =  04 
4 
input. string:4 

g*  -  INKEY*:  IF  g$  <>  " "  THEN  input. string    •  cle 
Ar   out  keyboard  buffer4 

yLine  -  CSRLIN:  xcoL  -  POS(0)  *  get 

screen  positions4 

PRINT  "<";: LOCATE   yLine,  xcoL  +  strLen  +  1:  PRINT 
■•>";:  LOCATE  yLine,  xcoL4 

pos.cntr  ■  1:  Len.cntr  ■»  14 

entry*  -  "":  backspace*  -  CHR*(8)  4 
next. key:  4 

IF  Len.cntr  ■»  pos.cntr  AND  Len.cntr  <>  strLen  +  1 
THEN4 

LOCATE  yLine, xcoL  +  pos.cntr:  PRINT  "_M;4 

END  IF4 
get. key:  4 

g*  ■  INKEY*:  IF  g*  =  ,,,,  THEN  get.key4 

ascii  »  ASC(g*>  4 

IF  ascii  -   13  THEN  quit. sub     *  return  4 

IF  ascii  ■    8  THEN  back-up      '  backspace4 

IF  ascii  *   30  THEN  move. right   '  cursor  right4 

IF  ascii  =   31  THEN  move. left    '  cursor  left4 

IF  ascii  =  127  THEN  wipe. out     '  del (ete)   4 

IF  Len.cntr  *  strLen  +  1  AND  Len.cntr  =  pos.cntr  T 
HEN  get.key4 

IF  emask  ■  0  OR  emask  ■  64  THEN  print. char4 
4 
'  AND  each  bit  of  emask  to  determine  edit  functions 
4 
4 
check. nums:   4 

IF  (emask  AND  1)  =  0  THEN  check.punct4 

IF  ascii  >=  48  AND  ascii  <*  57  THEN  print. char4 
check. punct:4 

IF  (emask  AND  2)  =  0  THEN  check. upLow4 

IF  ascii  =  46  OR  ascii  =  43  OR  ascii  =  45  THEN  pri 
nt. char4 
check. upLow:4 

IF  (emask  AND  12)  =  0  THEN  check. spaces4 

IF  ascii  <  65  OR  (ascii  >  90  AND  ascii  <  97)  OR  as 
cii  >  122  THEN  check. spaces4 

IF  (emask  AND  8)  THEN  g*  =  UCASE*(g*)4 

60T0  print. char4 
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check. spaces: 4 

IF  (emask  AND  16)  =  0  THEN  check- yorn4 

IF  g*  =  "  "  THEN  print- char4 
check. yorn:4 

IF  (emask  AND  32)  =  0  THEN  bad. char 4 

g*  =  UCASE*(g*):  IF  g*  =  "Y"  OR  g*  =  "N"  THEN  prin 
t. char4 

bad. char:        *  invalid  character  based  on  edit  ma 
sk4 

GOTO  get.key4 
print. char:      *  valid  character  so  print  it4 

IF  Len.cntr  =  pos.cntr  THEN        *  at  end  of  ente 
red  text  ?4 

PRINT  backspace*; g*; 4 
entry*  =  entry*  +  g*4 
Len.cntr  =  Len.cntr  +  14 
pos.cntr  «  pos.cntr  +  14 

ELSE  '  no,  in  middle 

of  entered  text4 

MID* (entry*, pos.  cntr , 1 )  =  g*4 
60T0  move.right4 

END  IF4 

GOTO  next. key4 
back. up:         '  delete  key  action4 

IF  entry*  -  " "  THEN  get.key4 

IF  pos.cntr  <>  Len.cntr  THEN  get.key4 

PRINT  backspace*;11  ";  backspace*;  4 

Len.cntr  =  Len.cntr  -  1:  pos.cntr  ■»  pos.cntr  -  14 

IF  LEN (entry*)  <  2  THEN  entry*  =  "":  GOTO  next. key 
4 

entry*  -  LEFT* (entry*, LEN (entry*) -1 ) :  GOTO  next.ke 
Y  « 
move. right:      'cursor  right  action4 

IF  pos.cntr  =  Len.cntr  THEN  next.key4 

char*  =  MID* (entry*, pos. cntr , 1 )4 

CALL  SetSoftStyLeSt  (WINDOW  (8),  0,poss.  styLe7.)    '  fo 
r  underlined  characters^ 

LOCATE  yLine,  xcoL  +  pos.cntr4 

PRINT  char*; 4 

pos.cntr  ■  pos.cntr  +  14 

char*  ■  MID*(entry*, pos. cntr, 1)4 

CALL  SetSof tStyLefc  (WINDOW  (8) ,  1 ,  poss.  styLe"/.)  4 

LOCATE  yLine,  xcoL  +  pos.cntr4 

PRINT  char*; 4 

CALL  SetSof tStyLefc  (WINDOW  (8)  ,0,  poss.  styLeV.)  4 

GOTO  next. key4 
move. left:       *  cursor  left  action4 

IF  pos.cntr  -  1  THEN  get.key4 

IF  (pos.cntr  =  Len.cntr)  AND  (Len.cntr  <>  strLen  + 
1)  THEN4 

LOCATE  yLine,  xcoL  +  pos.cntr4 
PRINT  "  ";4 
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END  IF4 

IF  pos.cntr  <  Len.cntr  THEN4 

char*  «  MID* (entry*, pos.cntr, 1)4 
CALL  SetSoftStyLefc (WINDOW (8)  ,  0,poss.  styLe"/.)  4 
LOCATE  yLine,  xcoL  +  pos.cntr4 
PRINT  char*; 4 
END  IF    4 

pos.cntr  *  pos.cntr  -  14 
char*  ■  MID*(entry*, pos.cntr, 1)4 
CALL  SetSof  tStyLeSc  (WINDOW  (8)  ,  1 ,  poss.  styLe7.)  4 
LOCATE  yLine, xcoL  +  pos.cntr4 
PRINT  char*; 4 

CALL  SetSof  tStyLeSc  (WINDOW  (8) ,  0,  poss.  styLe"/.)  4 
GOTO  get.key4 
wipe. out:        '  erase  WHOLE  input  field  &  position 
at  start  of  fielcK 

LOCATE  yLine, xcoL+1:  FOR  wo  -  1  TO  strLen:  PRINT  " 
";:  NEXT  wo4 
entry*  -  "":  pos.cntr  -  1:  Len.cntr  -  1:  LOCATE  yL 
ine,  xcoL+14 

GOTO  next.key4 
quit. sub:        '  return  to  calling  program4 

IF  (emask  AND  64)  AND  entry*  -  ""  THEN  next. key  4 
END  SUB4 
4 

EMASK  values   ===4 

=  all  characters  4 
=  numbers  only4 
«  .   -t-    -   punctuation4 
s  A-Z  ,  a-z   upper  and  lower  4 
=  A-Z  force  uppercase4 
s  blank  spaces  allowed  in  input4 
=  Y  or  N  only  (forced  uppercase)  4 
64  =  null  input  not  aliowedv 

mask  values  may  be  added  together  for  a  cum 
ulative  effect4 

REM   i.e.   an  emask  of  67  =  forced  entry  of  numbers 
and  punctuation4 

4 


REM 

„_ 

4 

REM 

0 

REM 

1 

REM 

2 

REM 

4 

REM 

8 

REM 

16 

REM 

32 

REM 

64 

4 

REM 

al 
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BASIC  BUTTON 

Robert  Katz 

Take  advantage  of  the  mouse  and  icon  inter/ace  with 

this  subprogram  that  you  can  use  in  your  own  Amiga 

Basic  programs.  A  demo  that  Jets  you  change  the 

speed  and  gender  of  the  Amiga's  voice  is  included. 

Perhaps  more  than  any  other  BASIC,  Amiga  Basic  is  extensi- 
ble. New  commands  are  easily  added  to  the  language.  "BUT- 
TON" takes  advantage  of  this  flexibility  to  add  a  BUTTON 
command  similar  to  the  one  in  Microsft  BASIC  for  the  Macin- 
tosh. Buttons  allow  a  menulike  choice  without  forcing  the  user 
to  hold  down  the  right  mouse  button  and  perform  a  menu  ac- 
tion. In  general,  you  use  a  button  when  you  want  the  choice 
to  be  intrusive;  you  use  menus  when  you  want  the  choice  to 
be  available  only  when  the  user  looks  for  it. 

Buttons  are  useful  when  you  want  several  choices  to  be 
displayed  and  alterable  at  once.  As  an  example,  if  you  were 
writing  a  telecommunications  terminal  program,  you  would 
probably  want  all  the  options  to  be  displayed  on  the  screen 
simultaneously.  (See  Figure  7-1  for  an  example.)  All  at  once, 
the  user  can  see  that  the  speed  of  communication  varies  be- 
tween 110  and  9600;  parity  may  be  even,  odd,  or  not  selected; 
and  the  data  and  stop  bits  may  be  selected  in  a  given  number 
of  ways.  All  of  the  current  settings  are  clearly  shown. 

Figure  7-1.  Example  of  Button  Choices 

Q  I1B  bits/second  Q  5  data  bits        (j,)  no  parUy 

(g)  388  bits/second  Q  6  data  bits        Q  CVBn  parity 

(~)  688  bHs/second  (jjj)  7  data  bits         (~\  odd  parity 

f*\  1288  bits/second  ("")  8  data  bits 

Q  2488  bHs/second 

Q  4888  bits/second  (j|)  I  stop  bit  [ok~] 

Q  9688  bits/second  (*\  2  stop  bits 

A  display  of  telecommunications  parameters  shows  current  settings. 
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The  BUTTON  command  is  implemented  as  a  subprogram. 
Subprograms  differ  from  subroutines  in  that  subprograms 
allow  local  variables  that  cannot  be  accessed  by  the  main  pro- 
gram or  other  subprograms.  When  you  use  a  subprogram,  you 
don't  have  to  worry  about  using  a  variable  that  is  already  be- 
ing used  by  the  main  program;  no  side  effects  are  possible 
(unless  you  specify  that  certain  variables  are  to  be  shared 
among  program  and  subprograms).  Although  the  variables  are 
independent,  it's  possible  to  pass  values  (called  parameters) 
back  and  forth  between  the  subprogram  and  its  calling 
program. 

A  subprogram  must  begin  with  a  SUB  statement  contain- 
ing the  name  of  the  subprogram  and  a  list  of  parameters.  The 
END  SUB  statement  marks  the  end  of  a  subprogram.  All  state- 
ments between  SUB  and  END  SUB  are  considered  part  of  the 
subprogram  rather  than  part  of  the  main  program. 

Program  1  is  the  subprogram  to  implement  the  BUTTON 
command.  Type  it  in  and  save  a  copy  to  disk,  but  don't  try  to 
run  it  yet.  This  isn't  a  complete  program,  only  a  subprogram. 
Since  you'll  want  to  merge  this  with  your  own  programs,  be 
sure  to  save  it  in  ASCII  format.  To  do  this,  you  must  use  a 
command  of  the  form 

SAVE  "filename" ,Pl 

Calling  All  Subprograms 

There  are  two  ways  for  the  main  program  to  access,  or  call,  a 
subprogram.  The  formal  method  is  with  a  statement  of  the 
form 

CALL  subprogram  name(parameter  list) 

However,  Amiga  Basic  also  permits  you  to  omit  the  CALL  and 
the  parentheses  surrounding  the  parameter  list.  This  format 
makes  the  subprogram  call  look  just  like  any  other  BASIC 
statement,  so  the  subprogram  essentially  becomes  a  new 
BASIC  command. 

Here's  the  syntax  for  the  BUTTON  command: 

BUTTON  ID,  state,  title,  x  position,  y  position,  type 
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The  ID  and  state  parameters  are  two-way  values.  Setting  them 
before  you  call  the  subprogram  provides  instructions  to  the 
subprogram,  and  reading  their  values  after  the  subprogram  is 
called  returns  information  on  the  buttons.  The  other  param- 
eters are  one-way:  They  provide  information  to  the  subprogram, 
but  nothing  is  reported  back  through  them.  One  difference  be- 
tween subprograms  and  actual  commands  is  that  you  must 
supply  some  value  for  all  the  parameters  in  a  subprogram  call. 
None  of  the  parameters  are  optional,  even  in  cases  where  the 
parameter  values  aren't  meaningful. 

The  ID  value  is  a  unique  number  by  which  you  can  iden- 
tify each  button.  You  may  have  any  number  of  buttons  on  the 
screen  at  once.  Allowable  button  numbers  range  from  1  up  to 
the  maximum  number  you  specify. 

An  ID  value  of  0  has  a  special  meaning.  When  the  sub- 
program is  called  with  this  value  in  the  first  parameter  posi- 
tion, it  checks  whether  the  mouse  is  currently  positioned  over 
any  previously  defined  button.  (In  this  case,  the  values  of  the 
other  parameters  are  not  important.)  If  the  mouse  is  over  a 
button,  then  the  ID  value  of  that  button  is  returned  in  the  ID 
parameter,  the  state  of  the  button  is  inverted  (from  1  to  2,  or 
vice  versa),  and  the  new  state  of  the  button  is  returned  in  the 
state  parameter.  If  the  mouse  isn't  over  any  of  the  buttons,  the 
ID  parameter  will  still  be  0  upon  return. 

Note  that  this  function  compares  the  current  mouse 
pointer  position  against  the  coordinates  for  all  defined  buttons, 
without  regard  for  whether  the  buttons  are  actually  being  dis- 
played on  the  screen  at  the  time  of  the  test.  To  prevent  spuri- 
ous readings,  it's  important  to  clear  button  definitions  when 
the  corresponding  buttons  are  erased  from  the  screen. 

The  state  parameter  determines  the  state  of  the  button 
specified  by  the  ID  parameter.  If  this  parameter  is  set  to  0 
when  the  subprogram  is  called,  then  the  current  definition  for 
the  specified  button  is  erased.  This  makes  the  button  inactive, 
but  doesn't  remove  it  from  the  screen.  If  this  parameter  is  set 
to  1,  then  the  specified  button  is  deselected  (turned  off).  Set- 
ting this  parameter  to  2  causes  the  corresponding  button  to  be 
selected  (turned  on).  The  remaining  parameters  are  only 
meaningful  the  first  time  the  subprogram  is  called  for  a  par- 
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ticular  ID  value.  Title  is  the  name  you  assign  to  a  button,  x  po- 
sition and  y  position  define  the  screen  coordinates  of  the 
button,  and  type  identifies  the  shape  of  the  button  as  described 
below.  Once  a  button  is  defined,  these  features  cannot  be 
changed. 

The  subprogram  provides  three  different  types  of  buttons. 
Type  1  is  a  rectangle  with  the  name  of  the  button  inside  it. 
When  a  type  1  button  is  selected,  the  button  name  appears  in 
reverse  video.  Type  2  buttons  are  squares  with  their  names  be- 
side them.  When  a  type  2  button  is  selected,  it's  marked  with 
an  X.  Type  3  buttons  are  circles  with  their  names  beside  them. 
When  a  type  3  button  is  selected,  a  smaller  filled  circle  is 
placed  inside  the  circle. 

Two  preparatory  steps  are  required  when  using  the  BUT- 
TON subprogram  in  your  own  programs.  First,  your  main  pro- 
gram should  begin  with  the  statement  DEFINT  a-z  to  force  all 
variables  to  default  to  the  short  integer  type.  Second,  because 
the  subprogram  makes  calls  to  operating  system  graphics 
routines,  you  must  place  a  copy  of  the  graphics. bmap  file  into 
the  disk  directory  that  holds  your  program.  The  graphics.bmap 
file  can  be  found  in  the  BasicDemo  folder  on  the  Extras  disk 
that  came  with  your  Amiga.  (If  you're  using  Workbench  ver- 
sion 1.2  see  Appendix  B.) 

Buttoned  Speech 

The  best  way  to  learn  how  to  use  the  BUTTON  subprogram  is 
by  looking  at  an  example.  Program  2  illustrates  all  three  types 
of  buttons  provided  by  the  BUTTON  subprogram.  It  sets  up  a 
control  panel  for  a  speech  synthesis  demonstration.  Buttons 
allow  you  to  change  the  voice  between  male  and  female,  and 
between  fast  and  slow.  There  are  also  buttons  to  start  or  stop 
the  voice.  To  try  Program  2,  type  it  in  as  listed  and  save  a 
copy,  but  don't  try  to  run  it  yet.  First  you  must  merge  in  the 
BUTTON  subprogram.  Use  a  command  of  the  form 

MERGE  "filename" 

where  filename  is  the  name  you  used  for  the  ASCII  file  con- 
taining the  subprogram.  After  the  subprogram  is  merged  in, 
the  combined  program  is  ready  to  run.  If  you  want,  you  can 
save  a  copy  of  the  completed  program  to  avoid  having  to 
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merge  the  subprogram  again. 

The  first  BUTTON  command  in  Program  2,  in  the  FOR- 
NEXT  loop,  provides  the  initial  definitions  of  the  six  buttons. 
The  second  BUTTON  command,  following  the  WEND,  has  the 
ID  parameter  set  to  zero  to  check  whether  the  mouse  pointer 
was  over  a  button  when  the  mouse  button  was  clicked.  If  so, 
the  variable  ID  will  have  a  nonzero  value  upon  return,  and  ar- 
ray element  State(ID)  will  hold  the  new  state  of  that  variable. 
(Although  Program  2  uses  a  variable  named  ID  for  the  ID  pa- 
rameter, that's  not  mandatory.  Any  other  variable  name  would 
work  just  as  well.)  The  final  BUTTON  command  is  used  to  set 
the  other  button  in  the  panel  pair  to  the  complementary  state. 
Note  that  dummy  values  are  supplied  for  the  last  three  param- 
eters in  the  latter  two  BUTTON  commands.  These  values  are 
necessary  to  satisfy  the  syntax  of  the  subprogram  call. 

Since  Program  2  defines  only  six  buttons,  the  default 
value  for  the  maxbut  variable  in  the  subprogram  is  sufficient. 
Should  your  application  require  more  than  ten  buttons,  simply 
increase  maxbut  to  whatever  value  you  need. 

After  examining  Program  2,  try  using  the  BUTTON  sub- 
program in  your  own  programs.  Remember  that  you  must 
place  a  copy  of  the  graphics.bmap  file  into  the  disk  folder  that 
holds  your  BASIC  programs  for  the  program  to  function 
properly. 

Technical  Details 

Because  there  is  no  easy  way  for  Amiga  Basic  to  print  text  at 
an  arbitrary  pixel  location,  the  BUTTON  subprogram  uses  an 
Amiga  operating  system  graphic  routine  called  Move.  Now, 
characters  can  be  placed  outside  of  normal  character  bound- 
aries. The  Move  routine  is  called  like  an  Amiga  Basic  subpro- 
gram. The  routine  has  three  parameters.  The  first  is  the 
address  of  the  current  window's  RastPort,  a  structure  used  by 
the  operating  system.  We  can  find  this  address  with  the  WIN- 
DOW(8)  function.  The  other  two  parameters  are  the  X  and  Y 
locations  (in  pixels)  that  specify  where  the  text  should  begin. 
Here's  an  example  of  a  call  to  Move: 

CALL  Move&(WINDOW(8),  X%,  Y%) 
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Note  that  X  and  Y  are  long  integers  (as  the  suffix  %  shows). 

One  other  system  routine  is  used  in  the  BUTTON  subpro- 
gram. This  routine,  SetDrMd,  changes  the  default  drawing 
mode.  This  is  used  to  invert  the  colors  when  a  type  1  button  is 
selected.  From  BASIC,  it's  called  like  this: 

CALL  SetDrMd&(WINDOW(8),i;a/we) 

Value  represents  one  of  the  four  available  drawing  modes.  Ta- 
ble 7-7  shows  the  modes  and  their  corresponding  values. 

Table  7-7.  Mode  Values 


Mode 

Value 

Jaml 

0 

Jam2 

1 

Complement 

2 

Inversvid 

3 

The  default  mode  is  Jam2.  It  "jams"  the  foreground  and 
background  colors  (as  an  8  x  8  rectangle)  onto  the  screen 
memory.  Jaml  jams  only  the  foreground  color  onto  the  screen, 
allowing  you  to  overlay  characters.  Complement  reverses  the 
colors,  changing  all  ones  to  zeros  and  all  zeros  to  ones.  For  in- 
stance, if  you  are  using  a  four-color  screen,  color  0  would 
switch  places  with  color  3,  and  color  1  would  switch  places 
with  color  2  (it  makes  more  sense  in  binary).  Inversvid  ex- 
changes the  foreground  color  with  the  background  color  to 
make  inverse  characters. 

Program  1.  BUTTON 

Filename:  BUTTON 

For  instructions  on  entering  these  programs,  please  refer  to  Appendix  B, 
"COMPUTEVs  Guide  to  Typing  In  Amiga  Programs." 

4 
4 
4 

*  BUTTON   subprogram* 

*  Copyright  1987,  COMPUTE!  Publications,  Inc. 4 

*  ALL  rights  reserved -4 
4 

SUB  BUTTON (ID, State, TitLe*,X,Y, Type)  STATIC4 
IF  ID=0  THEN  BOTO  CheckButton4 
IF  numbut>0  THEN  GOTO  Skipped4 
LIBRARY  "graphics. library"4 
rastport«c=WINDOW  (8)  4 
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CALL  SetDrMd&(rastportS<,0)4 

maxbut=104 

DIM  ID (maxbut) , State ( max but ) , TitLe* (maxbut) , Type (m 
axbut) 4 

DIM  XI (maxbut) ,Y1 (maxbut) , X2 (maxbut ) ,Y2(maxbut)4 

AREA (10, 10) : AREAFILL4 
4 
Skipped:4 

IF  (ID<0  OR  ID>maxbut  OR  State<0  OR  State>2  OR  Typ 
e>3)  THEN  EXIT  SUB  4 

IF  State=0  THEN  GOTO  EraseButton4 

IF  ID(ID)OID  THEN   4 
ID(ID)=ID4 

IF  ID>numbut  THEN  numbut»ID4 
TitLe* ( ID) ="  u+TitLe*+"  "4 
X1(ID)=X:Y1(ID)*Y   4 
Type (ID) *Type4 

END  IF4 

IF  TyptdDXl  THEN  GOTO  EraseButton4 

State ( ID) =State4 

ON  Type (ID)  GOTO  One,  Two,  Three4 
4 
One:  4 

X2(ID)=Xl(ID)+LEN(TitLe*(ID))*10+l:Y2(ID)=YKID)+l 
14 

LINE (XI (ID) ,Y1 (ID) )-(X2(ID) ,Y2(ID) ) ,0,bf4 

LINE(X1(ID),Y1(ID) )-(X2(ID),Y2(ID)),l,b4 

IF  State=2  THEN4 

LINE(XKID),YKID))-(X2(ID),Y2(ID)),l,bf    4 
CALL  SetDrMd&(rastport&,5)    4 

END  IF   4 

CALL  Move* (rastportfc, X 1 ( ID) +1 , Yl ( ID) +8) 4 

PRINT  TitLe* (ID): CALL  SetDrMd* (rastportfc, 1 ) 4 
EXIT  SUB4 
4 
Two:  4 

X2(ID)=X1(ID)+20:Y2(ID)=Y1(ID)+104 

LINE  (X1(ID),Y1(ID))-(X2(ID),Y2(ID)), l+(State=l)4 

LINE  (X1(ID).Y2(ID) )-(X2(ID) ,  YMID) ) , l+(State=l)4 

LINE  (XKID)  ,Y1(ID))-(X2(ID),Y2(ID)  ),  l,b     4 

CALL  Move& (rastportfc, X 1 ( ID) +23, Yl ( ID) +8)4 

PRINT  TitLe* (ID) 4 
EXIT  SUB4 
4 
Three: 4 

X2(ID)=X1(ID)+12:Y2(ID)=Y1(ID)+124 

Xc*X 1 ( ID) +5: Yc=Yl ( ID) +54 

CIRCLE  (Xc,Yc),124 

IF  State=2  THEN  CIRCLE  (Xc,Yc),64 

PAINT  (Xc,Yc),l+(State=l)4 

CALL  Move& (rastportfc, X 1 ( ID) +19, Yl ( ID) +8) 4 
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PRINT  TitLe*(ID)4 
EXIT  5UB4 
4 
CheckButton:4 

Xm=MOUSE ( 1 ) : Ym=MOUSE (2) 4 
Checkloop: 4 
ID=ID+14 

IF  ID>numbut  THEN4 
ID=04 
EXIT  SUB4 
END  IF4 

IF  ID(ID)=0  THEN  GOTO  Checkloop4 

IF  (Xm>XKID)  AND  Xm<X2(ID)  AND  Ym>YKID)  AND  Ym 
<Y2(ID) )  THEN  4 

State«l- (State ( ID) =1 ) 4 
GOTO  SkippecK 
END  IF    4 
GOTO  Checkloop4 
4 
EraseBut ton : 4 

ID ( ID) =0: State ( ID) =04 
TitLe*(ID)=""4 
XI (ID)=0:Y1(ID)=0   4 
Type (ID) =04 
EXIT  SUB4 
4 
END  SUB4 
4 
4 
4 

Program  2.  BUTTON  Demonstration 

Filename:  BUTTON.DEMO 

'BUTTON  Demo4 

'  Copyright  1987,  COMPUTE!  Publications,  Inc. 4 

*  ALL  rights  reserved. 4 

4 

DEFINT  a-z  4 

DIM  voice(8),word*(9),State(6),TitLe*(6),X(6),Y(6),T 

ype(6)4 

FOR  i=0  TO  8: READ  voice (i ): NEXT4 

DATA  1 10, 0, 150, 1 , 22200, 64, 10, 0, 04 

FOR  i-1  TO  9: READ  word* (i ) :NEXT4 

DATA  one, two, three, four , f i ve, si x , seven , ei ght , ni ne4 

LOCATE  1,10: PR INT  "Copyright  1987,  COMPUTE!  Pub li cat 

ions,  Inc."4 

LOCATE  2, 21: PRINT  "All  rights  reserved. "4 

'Initialize  buttons4 

FOR  ID-1  TO  64 
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READ  State ( ID) , Ti tLe* ( ID) , X ( ID) , Y ( ID) , Type ( ID) 4 
BUTTON  ID, State ( ID) , Ti  tLe* ( ID) , X ( ID) , Y  < ID) , Type (ID 

)4 

NEXT  4 

DATA  l,Male, 150,25, 14 

DATA  2, Female, 300, 25, 14 

DATA  1, Normal, 150,50,24 

DATA  2, Fast, 300, 50, 24 

DATA  1, Start, 155,75,34 

DATA  2, Stop, 305, 75, 34 

'Initialize  voice  parameters4 

GQSUB  Gender4 

GOSUB  SpeecK 

GOSUB  Status4 

count=14 

4 

here: 4 

WHILE  MOUSE  (0X14 
IF  speak  THEN4 

SAY  TRANSLATE* ( word* (count ) ) , voi ce4 
count=count+14 
IF  count >9  THEN  count=14 
END  IF4 

WEND: ID=04 

BUTTON  ID, State, "",0,0,04 

IF  ID=0  THEN  GOTO  here  'mouse  pressed  when  not  on 
a  button4 

State ( ID) =State4 

'Reverse  state  of  complementary  button4 

IF  (ID  MOD  2)  THEN  ID2=ID+1  ELSE  ID2=ID-14 

State ( ID2) =1- (State=l ) 4 

BUTTON  ID2, State ( ID2) , " " , 0, 0, 04 

'Change  operating  conditions  according  to  button  s 
election4 

ON  INT(  (ID/2)-*-- 5)  GOSUB  Gender ,  Speed,  Status4 

GOTO  here  4 
END4 
4 
Gender: 4 

IF  State(l)=2  THEN  voice (0) =1 10: voice (3) =0  ELSE  vo 
ice(0)=200: voice (3) =14 

RETURN4 
Speed: 4 

IF  State (3) =2  THEN  voice (2) =150  ELSE  voice (2) =2504 

RETURN4 
Status: 4 

speak= (State (5) =2) 4 

RETURN4 

4 
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'Merge  BUTTON  subprogram  here... 4 

4 

4 
4 
4 
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Appendix  A:  Menu 
Driver 

Brian  FJynn 

Here's  a  simple,  straightforward  file  menu  program 
for  the  Amiga.  It's  not  only  good  for  the  programs  in 
this  book,  but  can  be  adapted  to  all  your  BASIC  pro- 
gram disks.  Works  on  any  Amiga  with  Amiga  Basic. 


The  Amiga  is  without  a  doubt  one  of  the  most  impressive  per- 
sonal computers  on  the  market  today.  With  a  multitude  of 
complex  operations,  it  does  almost  anything  needed.  "Menu 
Driver"  takes  advantage  of  the  speed,  color,  and  mouse-selection 
features  in  allowing  you  to  choose  a  BASIC  application  to  run. 

How  to  Type  In  Menu  Driver 

Although  you  may  use  Menu  Driver  on  as  many  disks  as  you 
want,  you'll  only  have  to  type  it  in  once.  Type  it  in  exactly  as 
listed  and  save  a  copy  to  disk  before  you  do  anything  else. 
After  you  have  this  generic  copy  of  Menu  Driver  safely  tucked 
away,  you  can  begin  to  customize  it  for  your  own  needs. 
When  you're  ready,  simply  load  the  program  and  make  the 
changes  needed. 

Make  Your  Own  Modifications 

There  are  four  changes  that  need  to  be  made  to  Menu  Driver 
to  completely  customize  it.  The  first  is  in  the  initial  line  of  the 
program.  Change  this  remark  to  reflect  the  name  of  the  book, 
disk,  chapter,  and  so  forth,  that  you  are  handling  with  Menu 
Driver.  This  may  seem  trivial,  but  as  your  use  of  the  program 
grows,  it  enables  you  to  see  at  a  glance  what  version  you're 
looking  at.  Next,  change  the  WINDOW  statement  in  the 
SETSCREEN  subroutine  to  reflect  the  title  you  want  to  appear 
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in  the  window  menu  bar.  For  example,  the  line  could  be 
WINDOW  2,"Card  Games"„0,l 

for  this  book's  chapter  on  card  games. 

Now  change  the  value  of  the  variable  N  in  the  second 
line  of  the  KEYVALUES  subroutine  to  reflect  the  number  of 
programs  you  want  to  handle.  Typically,  if  you  had  ten  pro- 
grams you  wanted  to  access,  you  would  type  N  =  10.  Finally, 
at  the  end  of  the  program,  put  a  list  of  your  programs  into  the 
DATA  statements.  The  first  should  be  the  name  that  you  want 
to  appear  onscreen  as  the  title  of  the  chapter.  The  name  used 
in  the  WINDOW  statement  earlier  would  be  fine.  Each  of  the 
other  DATA  statements  have  two  parts:  the  name  of  the  pro- 
gram as  you  want  it  to  appear  on  the  menu  and  the  actual 
filename  on  disk.  For  instance,  if  you  had  a  program  that  drew 
a  clock  and  gave  the  time,  called  Amiga  Onscreen  Clock,  with 
a  filename  of  AMCLOCK  on  the  disk,  your  DATA  would  look 
like  this: 

DATA  Amiga  Onscreen  Clock,  AMCLOCK 

Be  sure  that  the  actual  filename  is  the  second  item  in  the 
DATA  statement. 

Using  Menu  Driver  with  This  Book 

You  should  make  a  menu  driver  for  each  chapter  in  this  book. 
Customize  each  version  of  Menu  Driver  using  the  instructions 
above.  To  load  and  run  a  program,  load  Amiga  Basic  and  then 
load  the  menu  driver  for  that  chapter.  Each  chapter's  menu 
driver  will  have  an  icon,  so  alternately  you  could  just  click  on 
that.  Using  this  method,  you  must  make  sure  you  always  keep 
a  copy  of  Amiga  Basic  in  the  directory  that  your  programs  are 
in.  Once  the  menu  driver  is  activated,  simply  click  on  the  pro- 
gram you  wish  to  run. 
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Menu  Driver 

Filename:  MENU  DRIVER 

For  instructions  on  entering  this  program,  please  refer  to  Appendix  B, 
"COMPUTER'S  Guide  to  Typing  In  Amiga  Programs." 

REM  Put  Chapter  Title  Here* 

BOSUB  INITIALIZE* 

GOBUB  MAIN- MENU* 

RUN  TITLE. SHORT* (PICK) 4 
END* 
4 
INITIALIZE!* 

Q08UB  8ET8CREEN4 

G08UB  KEYVALUE8* 

GOSUB  SETMENUS* 

G08UB  8ETC0L0R84 

GOSUB  SHAPES4 
RETURN* 

4 
SETSCREENI4 

SCREEN  1,640,200,3,24 

WINDOW  2, "Title",, 0, liREM  Chapter  Title4 

WIDTH  804 

CLS4 
RETURN* 
4 
KEYVALUESi* 

DEFINT  A-Z* 

N  ■  1  i  REM  N  it  the  nueber  of  prograe*  to  handle* 

DIM  TITLE. LONG*(N), TITLE. SHORT* <N)* 

DIM  CIRCLES (150) 4 

CIRCLE. 1(1)  -  It  CIRCLE. I (2)  -  794 

READ  CHAPTER** 

FOR  1-1  TO  N* 
READ  TITLE.LQNG«(I),TITLE.8HQRT*(I)* 

NEXT* 
RETURN* 
* 
SETMENUSi* 

FOR  1-2  TO  4* 
MENU  1,0,0,""* 

NEXT* 

MENU  1,0,1,"STOPM4 

MENU  1,1,1,"  Go  to  BASIC"* 

MENU  1,2,1,"  Go  to  8y»tee"4 

MENU  ON* 

ON  MENU  GOSUB  GOODBYE* 
RETURN* 
* 
GOODBYE:* 

WINDOW  CLOSE  2s  WINDOW  li  MENU  RESET* 
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SCREEN  CLOSE  14 

ITEM  -  MENU(l)* 

IF  ITEM  -  2  THEN  SYSTEM* 

CLS* 

PRINT  "Bye-Bye"* 

STOP* 
RETURN* 
* 
SETCOLORS: 4 

REM  TAN,  GREEN,  Sc  RED* 
PALETTE  4, .95, .7, .53* 
PALETTE  5, .14,. 43,0* 
PALETTE  6,. 93,. 2,0* 
RETURN* 
* 
SHAPES:* 

X=313:  Y=80s  Xl-X-7:  X2-X+7I  Yl«Y-3i  Y2-Y+3* 

LINE<X1,Y1)-<X2,Y2),4,BF* 

FOR  1=1  TO  2* 
K  =  7-1* 

CIRCLE<X,Y),7,Ks  PAINT(X, Y) ,K* 
GET  <  X 1 , Yl ) - <  X2, Y2) , CIRCLES (CIRCLE. I < I ) ) * 

NEXT* 
RETURN* 
* 
MAIN. MENU:* 

CLS* 

RTN*  =  "OFF":  PICK  -  1* 

S*  =  CHAPTER*:  L  -  LEN<S*>* 

LINE<313-10*L/2-15, 15) -(313+10»L/2+15,27) , 1,B* 

PAINT<313,20),6,1* 

COLOR  l,6i  LOCATE  3i  PRINT  PTAB(313-10tL/2)8t* 

LINE (135, 32) -(495, 130) ,2, Bi  PAINT<313,80) ,4,2* 

COLOR  2,4* 

FOR  1-1  TO  N* 
IF  I  -  PICK  THEN  INX  -  2  ELSE  INX  -  1* 
CALL  DRAW. CIRCLE (I, INX)* 
LOCATE  1+5,301  PRINT  TITLE.LQNG*(I)* 

NEXT* 

LINE(263, 141)-(3A0, 153), 2, Bi  PAINT (313, 145) ,3,2* 

COLOR  2,3* 

LOCATE  19i  PRINT  PTAB( 282) "Return"* 

COLOR  1,0* 

LOCATE  22,19:  PRINT  "Click  Mouse  on  Choice,"!* 

PRINT  "  then  Click  on  Return"* 

GOSUB  CHOOSE* 
RETURN* 
* 
SUB  DRAW. CIRCLE (R, INX)  STATIC* 

SHARED  CIRCLES ( ) , CIRCLE. I ( ) * 

Y  *  StR+32* 
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PUT  <  182,  Y) , CIRCLES (CIRCLE.  I  <INX) )  ,PSET* 
END  SUB* 
* 

CHOOSE s 4 
OOSUB  GURGLE* 
GOSUB  CLICK IT* 

IF  SI  ■  ""  THEN  80SUB  L0CATI0N4 
IF  ASC<S*+"  ")  <>  13  AND  RTN*  -  -OFF"  THEN* 

GOTO  CHOOSE* 
END  IF* 
RETURN* 
* 

BURBLE i* 
FREQ  -  300* 
FOR  G-l  TO  9* 
FREQ  -  S00  -  FREQ* 
SOUND  FREQ919S0* 
NEXT* 
RETURN* 
* 

CLICKITi* 
8*  -  "•* 
WHILE  HOUSE (0)  -  0  AND  8*  -  H>>* 

S*  -  INKEY** 
WEND* 
X  -  MQUSEU)* 
Y  *  MOUSE <2)* 
WHILE  MOUSE <0)<>  01  WENDi  REM  RESET* 
RETURN* 
* 

LOCATION:* 
IF  X>263  AND  X<360  AND  Y>141  AND  Y<1S3  THEN* 

RTN*  ■  "ON "4 
ELSE* 
P  -  INT<<Y-35>/9>  ♦  1* 

IF  X>170  AND  X<210  AND  P>0  AND  P<-  N  THEN* 
CALL  DRAW. CIRCLE (PICK, 1)* 
CALL  DRAW. CIRCLE <P,2>* 
PICK  -  P* 
END  IF* 
END  IF* 
RETURN* 
* 

REM  PROGRAMS* 
DATA  Chapter  Title  Goes  Here* 
DATA  Program  Title,  FILENAME* 
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The  precision  of  the  Amiga  is  very  evident  once  you  start  to 
type  in  a  program.  In  order  to  get  COMPUTERS  Amiga  listings 
to  operate  properly,  you  must  type  them  in  exactly  as  they  ap- 
pear. There  is  one  exception  to  this  rule. 

Entering  the  Listings 

Examine  a  listing.  At  the  end  of  each  line,  there  is  a  left-arrow 
character.  This  delimeter  should  not  be  typed  in  as  a  part  of 
the  line.  It's  there  just  to  let  you  know  where  the  end  of  the 
line  is.  When  you  are  typing  and  you  encounter  the  arrow,  you 
should  press  the  carriage  return. 

This  can  be  confusing,  because  the  arrows  don't  always 
look  as  though  they're  at  the  end  of  a  line.  You  may  see 
something  that  looks  like  this: 

Minut»Digit«l«CINT(RND)t72iHourDigit«l-INT<RND*12)*l 
24 

Even  though  this  appears  to  be  two  physical  lines,  it  is  ac- 
tually only  one  logical  line.  You  should  keep  typing  until  you 
get  to  the  left-arrow.  When  you  do,  press  the  RETURN  key. 
Your  Amiga  will  display  the  line  this  way: 

MinuteDigital=CINT(RND)*72:HourDigital=INT(RND*12)*12 

The  Amiga  will  not  always  display  your  lines  the  way 
they  look  in  the  book.  This  doesn't  mean  you've  made  an  er- 
ror. As  long  as  you  remember  to  place  the  carriage  returns  as 
indicated  by  the  left-arrows,  the  line  will  function  as  it  should 
if  you  haven't  made  any  typing  errors. 
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There's  another  thing  to  remember.  Sometimes  words  and 
numbers  are  broken  in  unlikely  places.  You  might  see 

IF   MENU<0)-1    THEN  ON  MENU(l)    QOSUB  practice, hours, ha 
1-f, five, quit* 

Again,  this  is  one  line  that  looks  like  two.  Type  it  in,  and 
the  Amiga  displays  it  this  way: 

If  MENU(0)  =  1  THEN  ON  MENU(l)  GOSUB  practice,hours,half,five,quit 

Keep  in  mind  also  that  the  Amiga  handles  line  numbers 
in  its  own  way.  Typically,  microcomputer  BASIC  line  editors 
will  insert  lines  in  their  proper  numerical  order  automatically. 
Since  the  Amiga  has  an  advanced  editor  that  needs  no  line 
numbers,  it  will  not.  The  Amiga  handles  line  numbers  as  la- 
bels. For  instance,  if  you  were  to  type  in  lines  10,  20,  and  30, 
and  then  go  back  and  type  in  line  25,  the  Amiga  would  exe- 
cute the  lines  in  just  that  order,  10,  20,  30,  and  25.  Simply 
make  sure  you  type  the  statements  in  the  programs  with  line 
numbers  in  the  exact  order  that  they  appear. 

One  more  note:  The  Amiga  is  quite  responsive  to  your 
keystrokes.  A  line  accepted  into  the  computer's  memory  can 
affect  all  the  other  lines  in  the  listing.  If  you  type  in  a  variable 
in  caps  the  first  time  and  then  mistakenly  in  lowercase  later 
on,  the  Amiga  line  editor  will  change  all  the  occurrences  of 
that  variable  to  lowercase.  This  makes  it  easy  for  you  to  get 
listings  with  all  kinds  of  lower-  and  uppercase  letters  that 
don't  match  the  book  listing.  In  general,  you'll  get  the  best  re- 
sults if  you  type  everything  just  the  way  you  see  it,  except  as 
noted  above. 

Saving  Your  Files 

Each  listing  has  a  suggested  filename.  Use  this  format  to  save 
your  files: 

SAVE  "FILENAME",A 

where  FILENAME  is  the  name  of  the  file  you  are  saving.  The 
,A  causes  your  file  to  be  saved  in  ASCII  format.  This  is  very 
important  because  it  enables  a  file  to  be  MERGED  with  an- 
other file. 
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Creating  .bmap  Files 

There  are  a  number  of  .bmap  files  used  in  the  programs  in  this 
book:  graphics.bmap,  diskfont.bmap,  exec. bmap,  and 
icon.bmap.  If  you  use  the  1.2  version  of  the  Extras  disk,  you 
should  use  the  following  procedure  to  create  these  .bmap  files. 

1.  From  Amiga  Basic,  type 

LOAD  "Extras:BasicDemos/ConvertFD" 

Run  the  program  after  it  loads. 

2.  When  the  prompt  Name  of  .fd  file  to  read>  comes  up,  type 
Extras:FD1.2/graphics_lib.fd 

3.  When  the  prompt  Name  of  .bmap  file  to  produce>  appears, 
type 

Libs:graphics.bmap 

You'll  get  several  warning  messages,  but  these  can  be  safely 
ignored. 

4.  When  the  program  finishes,  run  it  again  using 
Extras:FD1.2/diskfont_lib.fd 

and 
Libs-.diskfont.bmap 

respectively,  to  create  the  diskfont.bmap  file.  Run  the  pro- 
gram again,  this  time  using 

Extras:FD1.2/icon_lib.fd 

and 

Libs:icon.bmap 

to  create  the  icon.bmap  file. 

To  create  the  exec. bmap  file  run  ConvertFD  one  more 
time,  this  time  answering  the  prompts  with 

Extras:FD1.2/exec_lib.fd 

and 

Libsrexec.bmap 
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COMPUTEl's  Second  Book  of  Amiga  Disk  is  simple  to  use.  There 
are  a  couple  of  things  to  keep  in  mind  when  using  it. 

First  of  all,  COMPUTERS  Second  Book  of  Amiga  Disk  is  not 
a  startup  disk.  It  does  not  contain  any  of  the  Amiga  system 
programs.  So  in  order  to  use  it,  boot  your  computer  nor- 
mally— either  with  Kickstart  and  then  the  Workbench,  or  with 
Workbench  if  you  have  an  Amiga  with  Kickstart  already  in 
ROM. 

Once  the  computer  is  booted,  take  a  copy  of  Amiga  Basic 
and  place  it  onto  COMPUTEI's  Second  Book  of  Amiga  Disk. 
There  is  room  on  the  disk  for  one  copy  of  Amiga  Basic.  The 
reason  for  this  is  simple.  Whenever  you  try  to  run  the  COM- 
PUTE! programs,  the  Amiga  will  try  to  find  Amiga  Basic  in  the 
same  directory. 

If  you  don't  know  how  to  copy  programs  from  one  disk 
to  another,  here's  an  easy  way: 

1.  After  the  Amiga  is  up  and  running,  put  your  disk  with  a 
copy  of  Amiga  Basic  on  it  in  one  drive,  COMPUTEl's  Second 
Book  of  Amiga  Disk  in  the  other. 

2.  Click  on  the  icon  for  your  disk  that  has  Amiga  Basic  on  it. 

3.  Drag  the  Amiga  Basic  icon  on  top  of  the  icon  for  COM- 
PUTEl's Second  Book  of  Amiga  Disk. 

The  Amiga  will  copy  Amiga  Basic  from  your  original  disk  to 
COMPUTEl's  Second  Book  of  Amiga  Disk. 
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If  you  have  one  drive  only,  use  this  method: 

1.  After  the  Amiga  is  up  and  running,  open  up  a  CLI  window 
by  first  clicking  on  the  icon  for  your  Workbench  disk,  and 
then  clicking  on  the  CLI  icon. 

2.  At  the  prompt,  type 
COPY  C/COPY  to  RAM: 

and  press  RETURN,  and  the  Amiga  will  copy  the  COPY 
program  to  RAM:. 

3.  Next,  remove  the  Workbench  disk  and  place  the  disk  with 
your  copy  of  Amiga  Basic  on  it  into  the  drive. 

4.  At  the  CLI  prompt  type 

RAM.COPY  DFO:AMIGABASIC#?  to  RAM: 

and  press  RETURN,  and  the  Amiga  will  copy  Amiga  Basic 
to  RAM:. 

5.  Now  place  the  COMPUTEI's  Second  Book  of  Amiga  Disk  into 
the  drive  and  type 

RAM-.COPY  RAM:AMIGABASIC#?  to  DFO: 

and  press  RETURN,  and  the  Amiga  will  copy  Amiga  Basic 
to  COMPUTEI's  Second  Book  of  Amiga  Disk. 

Once  you  have  a  copy  of  Amiga  Basic  on  COMPUTEI's 
Second  Book  of  Amiga  Disk,  you  are  ready  to  use  it.  The  disk 
contains  menu  programs  for  each  chapter.  The  filenames  are 
these: 

STRATEGYGAMES 

CARDGAMES 

ARCADEGAMES 

FUNGAMES 

APPLICATIONS 

GRAPHICS 

PROGRAMMING 

INSIDEAMIGA 

Open  up  COMPUTEI's  Second  Book  of  Amiga  Disk  by  click- 
ing on  its  icon  and  then  click  on  one  of  the  filenames  shown 
above.  The  menu  programs  are  screen  prompted.  Just  click  the 
button  for  the  program  you  wish  to  run. 
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action  arcade  games  93-111 

Advanced  Amiga  BASIC  141 

Aegis  Images  179 

algorithm  174 

Amiga  Basic  subprograms  249-57, 

258-67 
animation  179 
applications  139-62 
"Banner  Printer"  program  listing 

143-48 
BASICDemos  disk  187,  220 
BASICDemos  drawer  226,  234,  249 
BasicDemos  folder  141 
.bmap  file  220-21 
bobs  179,  225-26 
BUTTON  258-63 

"Button  Demonstration"  program  list- 
ing 265-67 
"Button"  program  listing  263-65 
CALL  215,  221-22,  259 
"Canfield"  program  listing  80-88 
card  games  51-92 
"Casino  Blackjack"  program  listing 

70-76 
CHDIR  216 

CLI  (Command  Line  Interpreter)  246 
"Climber  5"  program  listing  97-103 
COMPUTER'S  Second  Book  of  Amiga  Disk 

instructions  278-79 
ConvertFD  program  187 
custom  text  fonts  219-22 
data  statements  225 
DECLARE  FUNCTION  222,  253 
default  drawing  mode  263 
DEF  FN  201-2,  205 
DEFLNG  222 

Deluxe  Paint  II  95,  173,  179,  232 
"Disk-Based  Fonts"  program  listing 

223-24 
diskfont.bmap  220-21 
"Diskfont.bmap  Filemaker"  program 

listing  149 
diskfont.library  220 
Division  by  zero  error  205 
educational  games  113-38 
80-column  font  215 
emask  250-51 
END  SUB  259 
entry$  250-51 
ESC  (ESCape  key)  142-43 
"Euchre"  program  listing  56-68 


exec. bmap  234 

Extras  disk  179,  226,  234,  249 

family  games  113-38 

FD1.2  directory  187,  220 

fonts  219-22 

Fonts  directory  219 

Fractal  Geometry  of  Nature,  The  173 

"Fractal  Mountains"  program  listing 
175-78 

fractals  173-74 

fractional  dimension  173 

GET  132-33 

Graphicraft  173,  179 

graphics  163-211 

graphics.bmap  141,  216,  234,  249 

graphics  library  220-21,  253 

graphics. library  215 

graphics  movement  132-33 

"GraphiDemo"  program  listing  166-71 

IFF  (Interchange  File  Format)  173, 
186-88 

IFF  to  BASIC  conversion  179-81 

"IFF  to  Icon  Translator"  program  listing 
188-92 

"IFF  Translator"  program  listing 
181-85 

ILBM  (Interleaved  Bitmap)  format  1 73, 
193 

illegal  keypresses  249 

image  files  179-81 

image  files  to  DATA  statements  conver- 
sion 225-31 

INFO  246 

INITIALIZE  232,  234 

INPUT  249 

input  routine  249 

INPUTSTRING  251 

"Jigsaw"  program  listing  133-38 

"Karma"  program  listing  27-35 

Kickstart  version  1.2  115,  253 

Laser  Chess  program  listing  11-20 

LIBRARY  215,  222,  232,  253 

LIBRARY  CLOSE  222 

library  routines  220 

LIBS  (libraries)  directories  215,  221,  253 

limiting  value  205 

local  variables  252 

"Marbles"  program  listing  105-11 

"Masked  Input  Demonstration"  pro- 
gram listing  254-57 

"Math  Draw"  program  listing  195-99 
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"Menu  Driver"  program  listing  273-75 
"Menu  Planner"  program  listing 

152-55 
MENU(O)  and  MENU(l)  functions  235 
mesh  perspectives  200,  202 
Modula-2  3 

"Monte  Carlo"  program  listing  90-92 
Move  graphic  routine  262 
Notepad  219 

OBJECT  commands  132,  179 
object  definition  225 
OBJECT.DRAW  commands  133 
object  images  225-27 
ON  TIMER  133 
parameters  259 
pixels  203 

Preferences  tool  215 
prime  numbers  245-46 
PRINT  222 
printing  142-43,  262 
programming  213-267 
PUT  132 

RAM  (Random  Access  Memory)  244 
"Ramdisker"  program  listing  247-48 
ramdisks  244-46 
RastPort  262 

recursive  definition  prime  numbers  245 
REMark  statements  222 
"Rememory"  program  listing  37-41 
saving  IFF  file  194 

saving  in  ASCII  format  221,  233,  259 
screen  color  changes  201 
screen  resolution  203 
SetDrMd  263 

SetSoftStyle  library  routine  253 
SHARED  251 


60-column  font  215 

SMENU  232,  234 

SMENUOFF  232,  235 

sprites  179,  225-26 

strategy  games  1-49 

strlen  250 

SUB  259 

SUBITEM  235 

SUBMENU  232 

subprogram  232,  249-52,  259 

"Supermenus  Demo"  program  listing 

241-43 
"Supermenus"  program  listing  236-41 
"System  Fonts"  program  listing  217-18 
system  libraries  220-21 
three-dimensional  graphs  200-206 
three-dimensional  perspective  204-5 
"3-D  Surfaces"  program  listing  206-11 
"Tiles"  program  listing  127-30 
Topaz  Eight  and  Nine  Point  fonts  215 
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To  order  your  copy  of  COMPUTEi's  Second  Book  of  Amiga 
Disk,  call  our  toll-free  US  order  line:  1-800-346-6767  or  send 
your  prepaid  order  to: 

Second  Book  of  Amiga  Disk 
COMPUTE!  Books 
P.O.  Box  2165 
Radnor,  PA  19089 

All  orders  must  be  prepaid  (check,  charge,  or  money  order).  PA 
residents  add  6%  sales  tax. 


Send 


$15.95  per  copy. 


copies  of  COMPUTE! 's  Second  Book  of  Amiga  Disk  at 


Subtotal  $_ 


Shipping  and  Handling:  $2.00/disk  $_ 


Sales  tax  (if  applicable)  $_ 


Total  payment  enclosed  $_ 


a  Payment  enclosed 

a  Charge  a  Visa  a  MasterCard  a  American  Express 
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Exp.  Date 
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State 


Please  allow  4-5  weeks  for  delivery. 
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H1  rom  zapping  your  opponent's  chess  pieces  with  a  laser 
A      to  creating  a  ramdisk,  the  programs  in  COMPUTE! $s  Sec- 
ond Book  of  Amiga  offer  a  gateway  to  the  inside  of  your  Amiga 
that  you've  never  walked  through  before. 

Here  are  some  of  the  best  gamest  applications,  program- 
ming tips,  and  graphics  aids  that  have  ever  appeared  in  COM- 
PUTE! magazine.  You'll  find  the  programs  and  articles  are  of 
the  same  high  quality  that  you've  always  expected  in  COM- 
PUTE! Books.  And,  best  of  all,  they're  ready  to  type  in  and  use. 

Here's  a  sample  of  what's  inside: 

•  Laser  Chess™,  winner  of  COMPUTEl's  $10,000  programming 
contest,  in  which  strategy  and  skill  are  used  to  defeat  your 
opponent. 

•  "Rememory,"  where  your  powers  of  recall  are  stretched  to  the 
limit  while  you  match  a  myriad  of  colorful  patterns. 

•  "Climber  5,"  a  sparkling  arcade  game  that  puts  you  on  a  sky- 
scraper to  retrieve  wayward  homeruns. 

•  "Canfield,"  with  its  turn-of-the-century  atmosphere  of  honky- 
tonks  and  bankrolls,  where  you  fight  the  odds  at  solitaire. 

•  "Ramdisker,"  a  program  that  demonstrates  writing  to  RAM- 
based  sequential  files. 

•  And  dozens  of  other  programs  that  will  instantly  become  a 
part  of  your  Amiga  library — ones  you'll  use  over  and  over 
again. 

Also  included  as  a  bonus  is  an  all-purpose  "Menu  Driver" 
program  that  can  be  used  on  any  of  your  Amiga  disks  for  BASIC 
programs.  With  full  instructions  included,  the  "Menu  Driver" 
allows  easy  access  to  BASIC  programs,  just  by  clicking  on  a 
button. 

COMPUTE!  Books  remains  the  leader  by  providing  readers 
with  more  in-depth  and  complete  coverage  of  the  Amiga  than 
can  be  found  anywhere  else.  From  top  to  bottom,  this  book  is 
no  exeception.  COMPUTERS  Second  Book  of  Amiga  continues  in 
the  tradition  of  excellence  you  have  come  to  expect  from  COM- 
PUTE! Books. 

$16.95 


ISBN    0-A7MSS-lS5-b 
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780874»551228 


